Choose.hs

{-|
Module      : Werewolf.Command.Choose
Description : Options and handler for the choose subcommand.

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

Options and handler for the choose subcommand.
-}

{-# LANGUAGE OverloadedStrings #-}

module Werewolf.Command.Choose (
    -- * Options
    Options(..),

    -- * Handle
    handle,
) where

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

import Data.Text (Text)

import Game.Werewolf
import Game.Werewolf.Command.Hunter    as Hunter
import Game.Werewolf.Command.Orphan    as Orphan
import Game.Werewolf.Command.Scapegoat as Scapegoat
import Game.Werewolf.Command.WolfHound as WolfHound

import Werewolf.Game
import Werewolf.Messages

data Options = Options
    { args :: [Text]
    } deriving (Eq, Show)

handle :: MonadIO m => Text -> Text -> Options -> m ()
handle callerName tag (Options args) = do
    unlessM (doesGameExist tag) $ exitWith failure
        { messages = [noGameRunningMessage callerName]
        }

    game <- readGame tag

    command <- case game ^. stage of
            HuntersTurn1    -> return $ Hunter.chooseCommand callerName (head args)
            HuntersTurn2    -> return $ Hunter.chooseCommand callerName (head args)
            OrphansTurn     -> return $ Orphan.chooseCommand callerName (head args)
            ScapegoatsTurn  -> return $ Scapegoat.chooseCommand callerName args
            WolfHoundsTurn  -> return $ WolfHound.chooseCommand callerName (head args)
            _               -> exitWith failure
                { messages = [playerCannotDoThatRightNowMessage callerName]
                }

    case runExcept (runWriterT $ execStateT (apply command >> checkStage >> checkGameOver) game) of
        Left errorMessages      -> exitWith failure { messages = errorMessages }
        Right (game, messages)  -> writeOrDeleteGame tag game >> exitWith success { messages = messages }