module Game.Werewolf.Game (
Game,
stage, round, players, events, boots, passes, allegianceChosen, allowedVoters, heal, healUsed,
poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed, see,
villageIdiotRevealed, votes,
Stage(..),
_DefendersTurn, _DevotedServantsTurn, _GameOver, _Lynching, _ScapegoatsTurn, _SeersTurn,
_Sunrise, _Sunset, _UrsussGrunt, _VillagesTurn, _WerewolvesTurn, _WildChildsTurn, _WitchsTurn,
_WolfHoundsTurn,
allStages,
stageCycle, stageAvailable,
Event(..),
_DevourEvent, _NoDevourEvent, _PoisonEvent,
newGame,
killPlayer,
getAllowedVoters, getPendingVoters, getVoteResult,
isFirstRound,
doesPlayerExist,
hasAnyoneWon, hasAngelWon, hasVillagersWon, hasWerewolvesWon,
) where
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)
data Game = Game
{ _stage :: Stage
, _round :: Int
, _players :: [Player]
, _events :: [Event]
, _boots :: Map Text [Text]
, _allegianceChosen :: Maybe Allegiance
, _allowedVoters :: [Text]
, _heal :: Bool
, _healUsed :: Bool
, _passes :: [Text]
, _poison :: Maybe Text
, _poisonUsed :: Bool
, _priorProtect :: Maybe Text
, _protect :: Maybe Text
, _roleModel :: Maybe Text
, _scapegoatBlamed :: Bool
, _see :: Maybe Text
, _villageIdiotRevealed :: Bool
, _votes :: Map Text Text
} deriving (Eq, Read, Show)
data Stage = DefendersTurn | DevotedServantsTurn | GameOver | Lynching | ScapegoatsTurn
| SeersTurn | Sunrise | Sunset | UrsussGrunt | VillagesTurn | WerewolvesTurn
| WildChildsTurn | WitchsTurn | WolfHoundsTurn
deriving (Eq, Read, Show)
data Event = DevourEvent Text
| NoDevourEvent
| PoisonEvent Text
deriving (Eq, Read, Show)
makeLenses ''Game
makePrisms ''Stage
makePrisms ''Event
allStages :: [Stage]
allStages =
[ VillagesTurn
, DevotedServantsTurn
, Lynching
, ScapegoatsTurn
, Sunset
, WolfHoundsTurn
, SeersTurn
, WildChildsTurn
, DefendersTurn
, WerewolvesTurn
, WitchsTurn
, Sunrise
, UrsussGrunt
, GameOver
]
stageCycle :: [Stage]
stageCycle = cycle allStages
stageAvailable :: Game -> Stage -> Bool
stageAvailable game DefendersTurn = has (players . defenders . alive) game
stageAvailable game DevotedServantsTurn =
has (players . devotedServants . alive) game
&& length (getVoteResult game) == 1
&& isn't devotedServant (head $ getVoteResult game)
stageAvailable _ GameOver = False
stageAvailable game Lynching = Map.size (game ^. votes) > 0
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
&& isNothing (game ^. allegianceChosen)
newGame :: [Player] -> Game
newGame players = game & stage .~ head (filter (stageAvailable game) stageCycle)
where
game = Game
{ _stage = Sunset
, _round = 0
, _players = players
, _events = []
, _boots = Map.empty
, _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
}
killPlayer :: Text -> Game -> Game
killPlayer name' = players . traverse . filteredBy name name' . state .~ Dead
getAllowedVoters :: Game -> [Player]
getAllowedVoters game =
map (\name' -> game ^?! players . traverse . filteredBy name name') (game ^. allowedVoters)
getPendingVoters :: Game -> [Player]
getPendingVoters game =
game ^.. players . traverse . alive . filtered ((`Map.notMember` votes') . view name)
where
votes' = game ^. votes
getVoteResult :: Game -> [Player]
getVoteResult game
| Map.null (game ^. votes) = []
| otherwise = 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 -> Bool
isFirstRound game = game ^. round == 0
doesPlayerExist :: Text -> Game -> Bool
doesPlayerExist name = has $ players . names . only name
hasAnyoneWon :: Game -> Bool
hasAnyoneWon game = any ($ game) [hasAngelWon, hasVillagersWon, hasWerewolvesWon]
hasAngelWon :: Game -> Bool
hasAngelWon game = has (players . angels) game && is dead angel && isn't villager angel
where
angel = game ^?! players . angels
hasVillagersWon :: Game -> Bool
hasVillagersWon = allOf (players . traverse . alive) (is villager)
hasWerewolvesWon :: Game -> Bool
hasWerewolvesWon = allOf (players . traverse . alive) (is werewolf)