{-| Module : Werewolf.Command.Help Description : Options and handler for the help subcommand. Copyright : (c) Henry J. Wylde, 2016 License : BSD3 Maintainer : public@hjwylde.com Options and handler for the help subcommand. -} {-# LANGUAGE OverloadedStrings #-} module Werewolf.Command.Help ( -- * Options Options(..), Command(..), -- * Handle handle, ) where import Control.Lens import Control.Monad.Extra import Control.Monad.IO.Class import Data.Function import Data.List import Data.Text (Text) import qualified Data.Text as T import Game.Werewolf import qualified Game.Werewolf.Role as Role import Werewolf.System data Options = Options { argCommand :: Maybe Command } deriving (Eq, Show) data Command = Commands { optAll :: Bool } | Rules { optAll :: Bool } | Roles { optAll :: Bool } deriving (Eq, Show) handle :: MonadIO m => Text -> Text -> Options -> m () handle callerName tag (Options (Just (Commands optAll))) = do mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) exitWith success { messages = map (privateMessage callerName) (commandsMessages callerName mGame) } handle callerName tag (Options (Just (Roles optAll))) = do roles <- (sortBy (compare `on` view Role.name) . nub) <$> ifM (doesGameExist tag &&^ return (not optAll)) (toListOf (players . roles) <$> readGame tag) (return allRoles) exitWith success { messages = map (privateMessage callerName . roleMessage) roles } handle callerName tag (Options (Just (Rules optAll))) = do mGame <- ifM (doesGameExist tag &&^ return (not optAll)) (Just <$> readGame tag) (return Nothing) exitWith success { messages = map (privateMessage callerName) (rulesMessages mGame) } handle callerName _ (Options Nothing) = exitWith success { messages = map (privateMessage callerName) helpMessages } commandsMessages :: Text -> Maybe Game -> [Text] commandsMessages callerName mGame = map (T.intercalate "\n") $ filter (/= []) [ [ "Global commands:" , "- `start ([-e|--extra-roles ROLE,...] | [-r|--random-extra-roles]) [--include-seer] PLAYER...`" , "- `end`" , "- `boot PLAYER`" , "- `quit`" , "- `version`" ] , [ "Status commands:" , "- `ping` ping the status of the current game publicly" , "- `status` get the status of the current game privately" , "- `circle [-a|--include-dead]` get the game circle" ] , [ "Standard commands:" , "- `vote PLAYER`" , "- `unvote`" ] , whenPlayerHasRole callerName mGame hunterRole [ "Hunter commands:" , "- `choose PLAYER`" ] , whenPlayerHasRole callerName mGame oracleRole [ "Oracle commands:" , "- `divine PLAYER`" ] , whenPlayerHasRole callerName mGame orphanRole [ "Orphan commands:" , "- `choose PLAYER`" ] , whenPlayerHasRole callerName mGame protectorRole [ "Protector commands:" , "- `protect PLAYER`" ] , whenPlayerHasRole callerName mGame scapegoatRole [ "Scapegoat commands:" , "- `choose PLAYER...`" ] , whenPlayerHasRole callerName mGame seerRole [ "Seer commands:" , "- `see PLAYER`" ] , whenPlayerHasRole callerName mGame witchRole [ "Witch commands:" , "- `heal`" , "- `poison PLAYER`" , "- `pass`" ] ] roleMessage :: Role -> Text roleMessage role = T.intercalate "\n" [ T.concat [role ^. Role.name, " (", T.pack . show $ role ^. balance, "):"] , role ^. description , role ^. rules ] rulesMessages :: Maybe Game -> [Text] rulesMessages mGame = map (T.intercalate "\n") [ [ T.unwords [ "Each player is informed of their role (see `help roles` for a list) at the start of the" , "game." ] , T.unwords [ "Each night, the Werewolves transform and subsequently assault and devour one Villager." , "After feasting, their lycanthropic form subsides and they once again hide in plain" , "sight." ] , T.unwords [ "Each day, after discovering the victim, the village gathers in the town square. In a" , "democratic fashion they then vote for whom they believe to be a Werewolf. The votee is" , "immediately tied to a pyre and burned alive in an attempt to rid Fougères of all" , "lupines." ] ] , filter (/= "") [ "A game begins at night and follows a standard cycle." , "- The village falls asleep." , whenRoleInPlay mGame orphanRole "- (First round only) the Orphan wakes up and chooses a role model." , whenRoleInPlay mGame villageDrunkRole "- (Third round only) the Village Drunk sobers up and remembers their allegiance." , whenRoleInPlay mGame seerRole "- The Seer wakes up and sees someone's allegiance." , whenRoleInPlay mGame oracleRole "- The Oracle wakes up and divines someone's role." , whenRoleInPlay mGame protectorRole "- The Protector wakes up and protects someone." , "- The Werewolves wake up and vote to devour a victim." , whenRoleInPlay mGame witchRole "- The Witch wakes up and may heal the victim and/or poison someone." , "- The village wakes up and find the victim." , whenRoleInPlay mGame hunterRole "- (When the Hunter is killed) the Hunter chooses someone to shoot." , whenRoleInPlay mGame druidRole "- Ferina grunts if the Druid is next to a Werewolf." , "- The village votes to lynch a suspect." , whenRoleInPlay mGame hunterRole "- (When the Hunter is killed) the Hunter chooses someone to shoot." , whenRoleInPlay mGame scapegoatRole "- (When the Scapegoat is blamed) the Scapegoat chooses whom may vote on the next day." , T.concat [ "The game is over when only Villagers or Werewolves are left alive" , ifRoleInPlay mGame fallenAngelRole ", or when one of the Loners completes their own objective." "." ] ] ] helpMessages :: [Text] helpMessages = map (T.intercalate "\n") [ [ T.unwords [ "Long has the woods been home to wild creatures, both kind and cruel. Most have faces and" , "are known to the inhabitants of Fougères in Brittany, France; but no-one from the" , "village has yet to lay eyes on the merciless Werewolf." ] , T.unwords [ "Each night Werewolves attack the village and devour the innocent. For centuries no-one" , "knew how to fight this scourge, however recently a theory has taken ahold that mayhaps" , "the Werewolves walk among the Villagers themselves..." ] ] , [ "Help commands:" , "- `help commands [-a | --all]`" , "- `help roles [-a | --all]`" , "- `help rules [-a | --all]`" ] ] whenPlayerHasRole :: Monoid m => Text -> Maybe Game -> Role -> m -> m whenPlayerHasRole _ Nothing _ m = m whenPlayerHasRole callerName (Just game) role' m | hasn't (players . traverse . named callerName) game = mempty | hasn't (role . only role') player = mempty | otherwise = m where player = game ^?! players . traverse . named callerName ifRoleInPlay :: Maybe Game -> Role -> a -> a -> a ifRoleInPlay Nothing _ true _ = true ifRoleInPlay (Just game) role' true false | has (players . roles . only role') game = true | otherwise = false whenRoleInPlay :: Monoid m => Maybe Game -> Role -> m -> m whenRoleInPlay mGame role m = ifRoleInPlay mGame role m mempty