{-|
Module      : Game.Werewolf.Command
Description : Command data structures.

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

Command data structures.
-}

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE RankNTypes            #-}

module Game.Werewolf.Command (
    -- * Command
    Command(..),

    -- ** Instances
    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]