module Game.Werewolf.Command (
Command(..),
killVoteCommand, lynchVoteCommand, noopCommand, quitCommand, seeCommand,
) where
import Control.Lens hiding (only)
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.State hiding (state)
import Control.Monad.Writer
import qualified Data.Map as Map
import Data.Text (Text)
import Game.Werewolf.Engine
import Game.Werewolf.Player hiding (doesPlayerExist)
import Game.Werewolf.Game hiding (isGameOver, isSeersTurn, isVillagersTurn, isWerewolvesTurn,
killPlayer)
import Game.Werewolf.Response
data Command = Command { apply :: forall m . (MonadError [Message] m, MonadState Game m, MonadWriter [Message] m) => m () }
killVoteCommand :: Text -> Text -> Command
killVoteCommand callerName targetName = Command $ do
validateArguments callerName targetName
unlessM isWerewolvesTurn $ throwError [playerCannotDoThatMessage callerName]
unlessM (isPlayerWerewolf callerName) $ throwError [playerCannotDoThatMessage callerName]
whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName]
votes %= Map.insert callerName targetName
lynchVoteCommand :: Text -> Text -> Command
lynchVoteCommand callerName targetName = Command $ do
validateArguments callerName targetName
unlessM isVillagersTurn $ throwError [playerCannotDoThatMessage callerName]
whenJustM (getPlayerVote callerName) . const $ throwError [playerHasAlreadyVotedMessage callerName]
votes %= Map.insert callerName targetName
noopCommand :: Command
noopCommand = Command $ return ()
quitCommand :: Text -> Command
quitCommand callerName = Command $ do
whenM isGameOver $ throwError [gameIsOverMessage callerName]
unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]
whenM (isPlayerDead callerName) $ throwError [playerIsDeadMessage callerName]
caller <- uses players $ findByName_ callerName
killPlayer caller
tell [playerQuitMessage caller]
sees %= Map.delete callerName
votes %= Map.delete callerName
seeCommand :: Text -> Text -> Command
seeCommand callerName targetName = Command $ do
validateArguments callerName targetName
unlessM isSeersTurn $ throwError [playerCannotDoThatMessage callerName]
unlessM (isPlayerSeer callerName) $ throwError [playerCannotDoThatMessage callerName]
whenJustM (getPlayerSee callerName) . const $ throwError [playerHasAlreadySeenMessage callerName]
sees %= Map.insert callerName targetName
validateArguments :: (MonadError [Message] m, MonadState Game m) => Text -> Text -> m ()
validateArguments callerName targetName = do
whenM isGameOver $ throwError [gameIsOverMessage callerName]
unlessM (doesPlayerExist callerName) $ throwError [playerDoesNotExistMessage callerName callerName]
unlessM (doesPlayerExist targetName) $ throwError [playerDoesNotExistMessage callerName targetName]
whenM (isPlayerDead callerName) $ throwError [playerIsDeadMessage callerName]
whenM (isPlayerDead targetName) $ throwError [targetIsDeadMessage callerName targetName]