module Game.Werewolf.Game (
Game,
variant, stage, round, players, boots, chosenVoters, deadRaised, divine, fallenAngelLynched,
healUsed, hunterRetaliated, jesterRevealed, marks, passed, poison, poisonUsed, priorProtect,
protect, roleModel, scapegoatBlamed, see, votes,
Stage(..),
_DruidsTurn, _GameOver, _HuntersTurn1, _HuntersTurn2, _Lynching, _NecromancersTurn,
_OraclesTurn, _OrphansTurn, _ProtectorsTurn, _ScapegoatsTurn, _SeersTurn, _Sunrise, _Sunset,
_VillageDrunksTurn, _VillagesTurn, _WerewolvesTurn, _WitchsTurn,
activity,
allStages,
stageCycle, stageAvailable,
newGame,
votee, allowedVoters, pendingVoters,
firstRound, secondRound, thirdRound,
getMarks,
hasAnyoneWon, hasDullahanWon, hasFallenAngelWon, hasNecromancerWon, hasVillagersWon,
hasWerewolvesWon, hasEveryoneLost,
) where
import Control.Lens.Extra
import Data.List.Extra
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.String.Humanise
import Data.Text (Text)
import Game.Werewolf.Player
import Game.Werewolf.Role hiding (activity, name)
import Game.Werewolf.Variant hiding (name)
import Prelude hiding (round)
data Game = Game
{ _variant :: Variant
, _stage :: Stage
, _round :: Int
, _players :: [Player]
, _boots :: Map Text [Text]
, _chosenVoters :: [Text]
, _deadRaised :: Bool
, _divine :: Maybe Text
, _fallenAngelLynched :: Bool
, _healUsed :: Bool
, _hunterRetaliated :: Bool
, _jesterRevealed :: Bool
, _marks :: [Text]
, _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 = DruidsTurn | GameOver | HuntersTurn1 | HuntersTurn2 | Lynching | NecromancersTurn
| OraclesTurn | OrphansTurn | ProtectorsTurn | ScapegoatsTurn | SeersTurn | Sunrise
| Sunset | VillageDrunksTurn | VillagesTurn | WerewolvesTurn | WitchsTurn
deriving (Eq, Read, Show)
instance Humanise Stage where
humanise DruidsTurn = "Druid's turn"
humanise GameOver = "Game over"
humanise HuntersTurn1 = "Hunter's turn"
humanise HuntersTurn2 = "Hunter's turn"
humanise Lynching = "Lynching"
humanise NecromancersTurn = "Necromancer's turn"
humanise OraclesTurn = "Oracle's turn"
humanise OrphansTurn = "Orphan's turn"
humanise ProtectorsTurn = "Protector's turn"
humanise ScapegoatsTurn = "Scapegoat's turn"
humanise SeersTurn = "Seer's turn"
humanise Sunrise = "Sunrise"
humanise Sunset = "Sunset"
humanise VillageDrunksTurn = "Village Drunk's turn"
humanise VillagesTurn = "village's turn"
humanise WerewolvesTurn = "Werewolves' turn"
humanise WitchsTurn = "Witch's turn"
makeLenses ''Game
makePrisms ''Stage
#if __GLASGOW_HASKELL__ >= 800
activity :: (Functor f, Contravariant f) => (Activity -> f Activity) -> Stage -> f Stage
#else
activity :: Getter Stage Activity
#endif
activity = to getter
where
getter DruidsTurn = Diurnal
getter GameOver = Diurnal
getter HuntersTurn1 = Diurnal
getter HuntersTurn2 = Diurnal
getter Lynching = Diurnal
getter NecromancersTurn = Nocturnal
getter OraclesTurn = Nocturnal
getter OrphansTurn = Nocturnal
getter ProtectorsTurn = Nocturnal
getter ScapegoatsTurn = Diurnal
getter SeersTurn = Nocturnal
getter Sunrise = Diurnal
getter Sunset = Diurnal
getter VillageDrunksTurn = Nocturnal
getter VillagesTurn = Diurnal
getter WerewolvesTurn = Nocturnal
getter WitchsTurn = Nocturnal
allStages :: [Stage]
allStages =
[ Sunset
, OrphansTurn
, VillageDrunksTurn
, NecromancersTurn
, SeersTurn
, OraclesTurn
, ProtectorsTurn
, WerewolvesTurn
, WitchsTurn
, Sunrise
, HuntersTurn2
, DruidsTurn
, VillagesTurn
, Lynching
, HuntersTurn1
, ScapegoatsTurn
, GameOver
]
stageCycle :: [Stage]
stageCycle = cycle allStages
stageAvailable :: Game -> Stage -> Bool
stageAvailable game DruidsTurn = 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 _ Lynching = True
stageAvailable game NecromancersTurn =
has (players . necromancers . alive) game
&& not (game ^. deadRaised)
stageAvailable game OraclesTurn = has (players . oracles . alive) game
stageAvailable game OrphansTurn =
has (players . orphans . alive) game
&& isNothing (game ^. roleModel)
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
&& is thirdRound game
stageAvailable game VillagesTurn = has allowedVoters game
stageAvailable game WerewolvesTurn = has (allowedVoters . werewolf) game
stageAvailable game WitchsTurn =
has (players . witches . alive) game
&& (not (game ^. healUsed) || not (game ^. poisonUsed))
newGame :: Variant -> [Player] -> Game
newGame variant players = Game
{ _variant = variant
, _stage = head stageCycle
, _round = 0
, _players = players
, _boots = Map.empty
, _passed = False
, _chosenVoters = []
, _deadRaised = False
, _divine = Nothing
, _fallenAngelLynched = False
, _healUsed = False
, _hunterRetaliated = False
, _jesterRevealed = False
, _marks = []
, _poison = Nothing
, _poisonUsed = False
, _priorProtect = Nothing
, _protect = Nothing
, _roleModel = Nothing
, _scapegoatBlamed = False
, _see = Nothing
, _votes = Map.empty
}
votee :: Fold Game Player
votee = folding getVotee
getVotee :: Game -> [Player]
getVotee game
| Map.null (game ^. votes) = []
| length result /= 1 = []
| otherwise = game ^.. players . traverse . named (head result)
where
votees = Map.elems $ game ^. votes
result = last $ groupSortOn (length . (`elemIndices` votees)) (nub votees)
allowedVoters :: Fold Game Player
allowedVoters = folding getAllowedVoters
getAllowedVoters :: Game -> [Player]
getAllowedVoters game
| not . null $ game ^. chosenVoters = filter ((`elem` game ^. chosenVoters) . view name) players'
| game ^. jesterRevealed = filter (isn't jester) players'
| otherwise = players'
where
players'
| has (stage . _WerewolvesTurn) game = game ^.. players . werewolves . alive
| otherwise = game ^.. players . traverse . alive
pendingVoters :: Fold Game Player
pendingVoters = folding getPendingVoters
getPendingVoters :: Game -> [Player]
getPendingVoters game = game ^.. allowedVoters . filtered ((`Map.notMember` votes') . view name)
where
votes' = game ^. votes
firstRound :: Prism' Game Game
firstRound = prism (set round 0) $ \game -> (if game ^. round == 0 then Right else Left) game
secondRound :: Prism' Game Game
secondRound = prism (set round 1) $ \game -> (if game ^. round == 1 then Right else Left) game
thirdRound :: Prism' Game Game
thirdRound = prism (set round 2) $ \game -> (if game ^. round == 2 then Right else Left) game
getMarks :: Game -> [Player]
getMarks game = map (\name -> game ^?! players . traverse . named name) (game ^. marks)
hasAnyoneWon :: Game -> Bool
hasAnyoneWon game = any ($ game)
[ hasDullahanWon
, hasFallenAngelWon
, hasNecromancerWon
, hasVillagersWon
, hasWerewolvesWon
]
hasDullahanWon :: Game -> Bool
hasDullahanWon game =
has (players . dullahans . alive) game
&& all (is dead) (getMarks game)
hasFallenAngelWon :: Game -> Bool
hasFallenAngelWon game = game ^. fallenAngelLynched
hasNecromancerWon :: Game -> Bool
hasNecromancerWon game =
not (hasEveryoneLost game)
&& allOf (players . traverse . alive)
(\player -> any ($ player) [is necromancer, is zombie, is jester]) game
hasVillagersWon :: Game -> Bool
hasVillagersWon game =
not (hasEveryoneLost game)
&& allOf (players . traverse . alive)
(\player -> any ($ player) [is villager, is dullahan, is fallenAngel]) game
hasWerewolvesWon :: Game -> Bool
hasWerewolvesWon game =
not (hasEveryoneLost game)
&& allOf (players . traverse . alive) (is werewolf) game
hasEveryoneLost :: Game -> Bool
hasEveryoneLost = allOf (players . traverse) (is dead)