module Game.Werewolf.Command.Status (
circleCommand, pingCommand, statusCommand,
) where
import Control.Lens
import Control.Monad.Extra
import Control.Monad.State hiding (state)
import Control.Monad.Writer
import Data.List
import Data.Text (Text)
import Game.Werewolf hiding (doesPlayerExist, getPendingVoters)
import Game.Werewolf.Messages
import qualified Game.Werewolf.Role as Role
import Game.Werewolf.Util
circleCommand :: Text -> Bool -> Command
circleCommand callerName includeDead = Command $ do
players' <- toListOf (players . traverse . if includeDead then id else alive) <$> get
tell [circleMessage callerName players']
pingCommand :: Text -> Command
pingCommand callerName = Command $ use stage >>= \stage' -> case stage' of
FerinasGrunt -> return ()
GameOver -> tell [gameIsOverMessage callerName]
HuntersTurn1 -> pingRole hunterRole
HuntersTurn2 -> pingRole hunterRole
Lynching -> return ()
OrphansTurn -> pingRole orphanRole
ProtectorsTurn -> pingRole protectorRole
ScapegoatsTurn -> pingRole scapegoatRole
SeersTurn -> pingRole seerRole
Sunrise -> return ()
Sunset -> return ()
VillageDrunksTurn -> pingRole villageDrunkRole
VillagesTurn -> pingVillagers
WerewolvesTurn -> pingWerewolves
WitchsTurn -> pingRole witchRole
pingRole :: (MonadState Game m, MonadWriter [Message] m) => Role -> m ()
pingRole role' = do
player <- findPlayerBy_ role role'
tell [pingRoleMessage $ role' ^. Role.name]
tell [pingPlayerMessage $ player ^. name]
pingVillagers :: (MonadState Game m, MonadWriter [Message] m) => m ()
pingVillagers = do
allowedVoterNames <- use allowedVoters
pendingVoterNames <- toListOf names <$> getPendingVoters
tell [waitingOnMessage Nothing $ allowedVoterNames `intersect` pendingVoterNames]
tell $ map pingPlayerMessage (allowedVoterNames `intersect` pendingVoterNames)
pingWerewolves :: (MonadState Game m, MonadWriter [Message] m) => m ()
pingWerewolves = do
pendingVoters <- getPendingVoters
tell [pingRoleMessage "Werewolves"]
tell $ map pingPlayerMessage (pendingVoters ^.. werewolves . name)
statusCommand :: Text -> Command
statusCommand callerName = Command $ use stage >>= \stage' -> case stage' of
FerinasGrunt -> return ()
GameOver -> tell [gameIsOverMessage callerName]
Lynching -> return ()
Sunrise -> return ()
Sunset -> return ()
VillagesTurn -> do
allowedVoterNames <- use allowedVoters
pendingVoterNames <- toListOf names <$> getPendingVoters
tell . standardStatusMessages stage' =<< use players
tell [waitingOnMessage (Just callerName) (allowedVoterNames `intersect` pendingVoterNames)]
WerewolvesTurn -> do
pendingVoterNames <- toListOf (werewolves . name) <$> getPendingVoters
tell . standardStatusMessages stage' =<< use players
whenM (doesPlayerExist callerName &&^ isPlayerWerewolf callerName) $
tell [waitingOnMessage (Just callerName) pendingVoterNames]
_ -> tell . standardStatusMessages stage' =<< use players
where
standardStatusMessages stage players =
currentStageMessages callerName stage ++
[ rolesInGameMessage (Just callerName) (players ^.. roles)
, playersInGameMessage callerName players
]