packages feed

werewolf-0.4.2.0: app/Werewolf/Commands/Start.hs

{-|
Module      : Werewolf.Commands.Start
Description : Options and handler for the start subcommand.

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

Options and handler for the start subcommand.
-}

module Werewolf.Commands.Start (
    -- * Options
    Options(..),

    -- * Handle
    handle,
) where

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

import           Data.List
import           Data.Text (Text)
import qualified Data.Text as T

import Game.Werewolf.Engine   hiding (isGameOver)
import Game.Werewolf.Game
import Game.Werewolf.Response
import Game.Werewolf.Role

-- | Options.
data Options = Options
    { optExtraRoleNames :: [Text]
    , argPlayers        :: [Text]
    } deriving (Eq, Show)

-- | Handle.
handle :: MonadIO m => Text -> Options -> m ()
handle callerName (Options extraRoleNames playerNames) = do
    whenM doesGameExist . whenM (fmap (not . isGameOver) readGame) $ exitWith failure {
        messages = [gameAlreadyRunningMessage callerName]
        }

    result <- runExceptT $ do
        extraRoles <- forM extraRoleNames $ \roleName -> maybe
            (throwError [roleDoesNotExistMessage callerName roleName])
            return
            (findByName roleName)

        players <- createPlayers (callerName:playerNames) extraRoles

        runWriterT $ startGame callerName players >>= execStateT checkStage

    case result of
        Left errorMessages      -> exitWith failure { messages = errorMessages }
        Right (game, messages)  -> writeGame game >> exitWith success { messages = messages }


findByName :: Text -> Maybe Role
findByName name = find ((name ==) . T.toLower . _name) allRoles