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 Control.Lens.Extra
import Data.List.Extra
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.String
import Data.String.Humanise
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 Humanise Stage where
humanise FerinasGrunt = fromString "Ferina's Grunt"
humanise GameOver = fromString "Game over"
humanise HuntersTurn1 = fromString "Hunter's turn"
humanise HuntersTurn2 = fromString "Hunter's turn"
humanise Lynching = fromString "Lynching"
humanise OrphansTurn = fromString "Orphan's turn"
humanise ProtectorsTurn = fromString "Protector's turn"
humanise ScapegoatsTurn = fromString "Scapegoat's turn"
humanise SeersTurn = fromString "Seer's turn"
humanise Sunrise = fromString "Sunrise"
humanise Sunset = fromString "Sunset"
humanise VillageDrunksTurn = fromString "Village Drunk's turn"
humanise VillagesTurn = fromString "village's turn"
humanise WerewolvesTurn = fromString "Werewolves' turn"
humanise WitchsTurn = fromString "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)