module Game.Werewolf.Game (
Game,
stage, round, players, events, boots, allowedVoters, heal, healUsed, hunterRetaliated,
jesterRevealed, passed, poison, poisonUsed, priorProtect, protect, roleModel, scapegoatBlamed,
see, votes,
Stage(..),
_FerinasGrunt, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _OrphansTurn,
_ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset, _VillageDrunksTurn,
_VillagesTurn, _WerewolvesTurn, _WitchsTurn,
allStages,
stageCycle, stageAvailable,
Event(..),
_DevourEvent, _NoDevourEvent, _PoisonEvent,
newGame,
killPlayer,
getAllowedVoters, getPendingVoters, getVoteResult,
isFirstRound, isThirdRound,
doesPlayerExist,
hasAnyoneWon, hasFallenAngelWon, 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.String.ToString
import Data.Text (Text)
import Game.Werewolf.Player
import Prelude hiding (round)
data Game = Game
{ _stage :: Stage
, _round :: Int
, _players :: [Player]
, _events :: [Event]
, _boots :: Map Text [Text]
, _allowedVoters :: [Text]
, _heal :: Bool
, _healUsed :: Bool
, _hunterRetaliated :: Bool
, _jesterRevealed :: Bool
, _passed :: Bool
, _poison :: Maybe Text
, _poisonUsed :: Bool
, _priorProtect :: Maybe Text
, _protect :: Maybe Text
, _roleModel :: Maybe Text
, _scapegoatBlamed :: Bool
, _see :: Maybe Text
, _votes :: Map Text Text
} deriving (Eq, Read, Show)
data Stage = FerinasGrunt | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | OrphansTurn
| ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise | Sunset | VillageDrunksTurn
| VillagesTurn | WerewolvesTurn | WitchsTurn
deriving (Eq, Read, Show)
instance ToString Stage where
toString FerinasGrunt = "Ferina's Grunt"
toString GameOver = "Game over"
toString HuntersTurn1 = "Hunter's turn"
toString HuntersTurn2 = "Hunter's turn"
toString Lynching = "Lynching"
toString OrphansTurn = "Orphan's turn"
toString ProtectorsTurn = "Protector's turn"
toString ScapegoatsTurn = "Scapegoat's turn"
toString SeersTurn = "Seer's turn"
toString Sunrise = "Sunrise"
toString Sunset = "Sunset"
toString VillageDrunksTurn = "Village Drunk's turn"
toString VillagesTurn = "village's turn"
toString WerewolvesTurn = "Werewolves' turn"
toString WitchsTurn = "Witch's turn"
data Event = DevourEvent Text
| NoDevourEvent
| PoisonEvent Text
deriving (Eq, Read, Show)
makeLenses ''Game
makePrisms ''Stage
makePrisms ''Event
allStages :: [Stage]
allStages =
[ VillagesTurn
, Lynching
, HuntersTurn1
, ScapegoatsTurn
, Sunset
, OrphansTurn
, VillageDrunksTurn
, SeersTurn
, ProtectorsTurn
, WerewolvesTurn
, WitchsTurn
, Sunrise
, HuntersTurn2
, FerinasGrunt
, GameOver
]
stageCycle :: [Stage]
stageCycle = cycle allStages
stageAvailable :: Game -> Stage -> Bool
stageAvailable game FerinasGrunt = has (players . druids . alive) game
stageAvailable _ GameOver = False
stageAvailable game HuntersTurn1 =
has (players . hunters . dead) game
&& not (game ^. hunterRetaliated)
stageAvailable game HuntersTurn2 =
has (players . hunters . dead) game
&& not (game ^. hunterRetaliated)
stageAvailable game Lynching = Map.size (game ^. votes) > 0
stageAvailable game ProtectorsTurn = has (players . protectors . alive) game
stageAvailable game ScapegoatsTurn = game ^. scapegoatBlamed
stageAvailable game SeersTurn = has (players . seers . alive) game
stageAvailable _ Sunrise = True
stageAvailable _ Sunset = True
stageAvailable game VillageDrunksTurn =
has (players . villageDrunks . alive) game
&& isThirdRound game
stageAvailable game VillagesTurn =
(has (players . fallenAngels . alive) game || not (isFirstRound game))
&& any (is alive) (getAllowedVoters game)
stageAvailable game WerewolvesTurn = has (players . werewolves . alive) game
stageAvailable game OrphansTurn =
has (players . orphans . alive) game
&& isNothing (game ^. roleModel)
stageAvailable game WitchsTurn =
has (players . witches . alive) game
&& (not (game ^. healUsed) || not (game ^. poisonUsed))
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
, _passed = False
, _allowedVoters = players ^.. names
, _heal = False
, _healUsed = False
, _hunterRetaliated = False
, _jesterRevealed = False
, _poison = Nothing
, _poisonUsed = False
, _priorProtect = Nothing
, _protect = Nothing
, _roleModel = Nothing
, _scapegoatBlamed = False
, _see = Nothing
, _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
isThirdRound :: Game -> Bool
isThirdRound game = game ^. round == 2
doesPlayerExist :: Text -> Game -> Bool
doesPlayerExist name = has $ players . names . only name
hasAnyoneWon :: Game -> Bool
hasAnyoneWon game = any ($ game) [hasFallenAngelWon, hasVillagersWon, hasWerewolvesWon]
hasFallenAngelWon :: Game -> Bool
hasFallenAngelWon game = has (players . fallenAngels) game && is dead fallenAngel && isn't villager fallenAngel
where
fallenAngel = game ^?! players . fallenAngels
hasVillagersWon :: Game -> Bool
hasVillagersWon = allOf (players . traverse . alive) (is villager)
hasWerewolvesWon :: Game -> Bool
hasWerewolvesWon = allOf (players . traverse . alive) (is werewolf)