Werewolf.hs

{-|
Module      : Game.Werewolf.Command.Werewolf
Description : Werewolf commands.

Copyright   : (c) Henry J. Wylde, 2016
License     : BSD3
Maintainer  : public@hjwylde.com

Werewolf commands.
-}

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Game.Werewolf.Command.Werewolf (
    -- * Commands
    unvoteCommand, voteCommand,

    -- ** Validation
    validatePlayer,
) where

import Control.Lens
import Control.Monad.Except
import Control.Monad.Extra
import Control.Monad.State
import Control.Monad.Writer

import           Data.List
import qualified Data.Map   as Map
import           Data.Maybe
import           Data.Text  (Text)

import Game.Werewolf
import Game.Werewolf.Command
import Game.Werewolf.Message.Command
import Game.Werewolf.Message.Error
import Game.Werewolf.Util

unvoteCommand :: Text -> Command
unvoteCommand callerName = Command $ do
    validateCommand callerName
    whenM (isNothing <$> getPlayerVote callerName) $ throwError [playerHasNotVotedMessage callerName]

    votes %= Map.delete callerName

    aliveWerewolfNames  <- toListOf (players . werewolves . alive . name) <$> get
    caller              <- findPlayerBy_ name callerName

    tell [playerRescindedVoteMessage werewolfName caller | werewolfName <- aliveWerewolfNames \\ [callerName]]

voteCommand :: Text -> Text -> Command
voteCommand callerName targetName = Command $ do
    validateCommand callerName
    whenM (isJust <$> getPlayerVote callerName) $ throwError [playerHasAlreadyVotedMessage callerName]
    validatePlayer callerName targetName
    whenM (isPlayerWerewolf targetName)         $ throwError [playerCannotDevourAnotherWerewolfMessage callerName]
    whenM (isPlayerZombie targetName)           $ throwError [playerCannotChooseZombieMessage callerName]

    votes %= Map.insert callerName targetName

    aliveWerewolfNames  <- toListOf (players . werewolves . alive . name) <$> get
    caller              <- findPlayerBy_ name callerName
    target              <- findPlayerBy_ name targetName

    tell [playerMadeDevourVoteMessage werewolfName caller target | werewolfName <- aliveWerewolfNames \\ [callerName]]

validateCommand :: (MonadError [Message] m, MonadState Game m) => Text -> m ()
validateCommand callerName = do
    validatePlayer callerName callerName
    unlessM (isPlayerWerewolf callerName)   $ throwError [playerCannotDoThatMessage callerName]
    unlessM isWerewolvesTurn                $ throwError [playerCannotDoThatRightNowMessage callerName]