Start.hs

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

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

Options and handler for the start subcommand.
-}

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

module Werewolf.Command.Start (
    -- * Options
    Options(..), ExtraRoles(..),

    -- * Handle
    handle,
) where

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

import Data.Text (Text)

import           Game.Werewolf
import           Game.Werewolf.Engine
import           Game.Werewolf.Message.Error
import qualified Game.Werewolf.Variant       as Variant

import System.Random.Shuffle

import Werewolf.System

data Options = Options
    { optExtraRoles :: ExtraRoles
    , optVariant    :: Text
    , argPlayers    :: [Text]
    } deriving (Eq, Show)

data ExtraRoles = None | Random | Use [Text]
    deriving (Eq, Show)

handle :: (MonadIO m, MonadRandom m) => Text -> Text -> Options -> m ()
handle callerName tag (Options extraRoles variant playerNames) = do
    whenM (doesGameExist tag &&^ (hasn't (stage . _GameOver) <$> readGame tag)) $ exitWith failure
        { messages = [gameAlreadyRunningMessage callerName]
        }

    result <- runExceptT $ do
        extraRoles' <- case extraRoles of
            None            -> return []
            Random          -> randomExtraRoles $ length playerNames
            Use roleNames   -> useExtraRoles callerName roleNames

        variant' <- useVariant callerName variant

        let defaultVillagerRole = if is spitefulVillage variant' then spitefulVillagerRole else simpleVillagerRole
        let roles = padRoles extraRoles' (length playerNames + 1) defaultVillagerRole

        players <- createPlayers (callerName:playerNames) <$> shuffleM roles

        runWriterT $ startGame callerName variant' players >>= execStateT checkStage

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

randomExtraRoles :: MonadRandom m => Int -> m [Role]
randomExtraRoles n = do
    let minimum = n `div` 4 + 1
    let maximum = n `div` 3 + 1

    count <- getRandomR (minimum, maximum)

    take count <$> shuffleM restrictedRoles

useExtraRoles :: MonadError [Message] m => Text -> [Text] -> m [Role]
useExtraRoles callerName roleNames = forM roleNames $ \roleName -> case findRoleByTag roleName of
    Just role   -> return role
    Nothing     -> throwError [roleDoesNotExistMessage callerName roleName]

findRoleByTag :: Text -> Maybe Role
findRoleByTag tag' = restrictedRoles ^? traverse . filteredBy tag tag'

useVariant :: MonadError [Message] m => Text -> Text -> m Variant
useVariant callerName variantName = case findVariantByTag variantName of
    Just variant   -> return variant
    Nothing         -> throwError [variantDoesNotExistMessage callerName variantName]

findVariantByTag :: Text -> Maybe Variant
findVariantByTag tag' = allVariants ^? traverse . filteredBy Variant.tag tag'

padRoles :: [Role] -> Int -> Role -> [Role]
padRoles roles n defaultVillagerRole = roles ++ villagerRoles ++ simpleWerewolfRoles
    where
        goal                    = 3
        m                       = max (n - length roles) 0
        startingBalance         = sumOf (traverse . balance) roles
        simpleWerewolfBalance   = simpleWerewolfRole ^. balance

        -- Little magic here to calculate how many Werewolves and Villagers we want.
        -- This tries to ensure that the balance of the game is between -3 and 2.
        simpleWerewolvesCount   = (goal - m - startingBalance) `div` (simpleWerewolfBalance - 1) + 1
        villagersCount          = m - simpleWerewolvesCount

        -- N.B., if roles is quite unbalanced then one list will be empty.
        villagerRoles       = replicate villagersCount defaultVillagerRole
        simpleWerewolfRoles = replicate simpleWerewolvesCount simpleWerewolfRole

createPlayers :: [Text] -> [Role] -> [Player]
createPlayers = zipWith newPlayer