{-| Module : Werewolf.Options Description : Optparse utilities. Copyright : (c) Henry J. Wylde, 2016 License : BSD3 Maintainer : public@hjwylde.com Optparse utilities. -} {-# LANGUAGE OverloadedStrings #-} module Werewolf.Options ( -- * Options Options(..), Command(..), -- * Optparse werewolfPrefs, werewolfInfo, werewolf, ) where import Data.Text (Text) import qualified Data.Text as T import Data.Version (showVersion) import qualified Werewolf.Command.Boot as Boot import qualified Werewolf.Command.Choose as Choose import qualified Werewolf.Command.Circle as Circle import qualified Werewolf.Command.End as End import qualified Werewolf.Command.Help as Help import qualified Werewolf.Command.Interpret as Interpret import qualified Werewolf.Command.Poison as Poison import qualified Werewolf.Command.Protect as Protect import qualified Werewolf.Command.See as See import qualified Werewolf.Command.Start as Start import qualified Werewolf.Command.Vote as Vote import qualified Werewolf.Version as This import Options.Applicative data Options = Options { optCaller :: Text , optTag :: Text , argCommand :: Command } deriving (Eq, Show) data Command = Boot Boot.Options | Choose Choose.Options | Circle Circle.Options | End End.Options | Heal | Help Help.Options | Interpret Interpret.Options | Pass | Ping | Poison Poison.Options | Protect Protect.Options | Quit | See See.Options | Start Start.Options | Status | Version | Vote Vote.Options deriving (Eq, Show) -- | The default preferences. -- Limits the help output to 100 columns. werewolfPrefs :: ParserPrefs werewolfPrefs = prefs $ columns 100 -- | An optparse parser of a werewolf command. werewolfInfo :: ParserInfo Options werewolfInfo = info (infoOptions <*> werewolf) (fullDesc <> header' <> progDesc') where infoOptions = helper <*> version version = infoOption ("Version " ++ showVersion This.version) $ mconcat [ long "version", short 'V', hidden , help "Show this binary's version" ] header' = header "A game engine for running werewolf within a chat client." progDesc' = progDesc "This engine is based off of the party game Mafia, also known as Werewolf." -- | An options parser. werewolf :: Parser Options werewolf = Options <$> fmap T.pack (strOption $ mconcat [ long "caller", metavar "PLAYER" , help "Specify the calling player's name" ]) <*> fmap T.pack (strOption $ mconcat [ long "tag", metavar "TAG" , help "Specify the game tag (for running multiple games at once)" ]) <*> subparser (mconcat [ command "boot" $ info (helper <*> boot) (fullDesc <> progDesc "Vote to boot a player") , command "choose" $ info (helper <*> choose) (fullDesc <> progDesc "Choose an allegiance or player(s)") , command "circle" $ info (helper <*> circle) (fullDesc <> progDesc "Get the game circle") , command "end" $ info (helper <*> end) (fullDesc <> progDesc "End the current game") , command "heal" $ info (helper <*> heal) (fullDesc <> progDesc "Heal the devoured player") , command "help" $ info (helper <*> help_) (fullDesc <> progDesc "Help documents") , command "interpret" $ info (helper <*> interpret) (fullDesc <> noIntersperse <> progDesc "Interpret a command") , command "pass" $ info (helper <*> pass) (fullDesc <> progDesc "Pass") , command "ping" $ info (helper <*> ping) (fullDesc <> progDesc "Ping the status of the current game publicly") , command "poison" $ info (helper <*> poison) (fullDesc <> progDesc "Poison a player") , command "protect" $ info (helper <*> protect) (fullDesc <> progDesc "Protect a player") , command "quit" $ info (helper <*> quit) (fullDesc <> progDesc "Quit the current game") , command "see" $ info (helper <*> see) (fullDesc <> progDesc "See a player's allegiance") , command "start" $ info (helper <*> start) (fullDesc <> progDesc "Start a new game") , command "status" $ info (helper <*> status) (fullDesc <> progDesc "Get the status of the current game") , command "version" $ info (helper <*> version) (fullDesc <> progDesc "Show this engine's version") , command "vote" $ info (helper <*> vote) (fullDesc <> progDesc "Vote against a player") ]) boot :: Parser Command boot = Boot . Boot.Options <$> playerArgument choose :: Parser Command choose = Choose . Choose.Options . map T.pack <$> some (strArgument $ metavar "(ALLEGIANCE | PLAYER...)") circle :: Parser Command circle = Circle . Circle.Options <$> switch (mconcat [ long "include-dead", short 'a' , help "Include dead players" ]) end :: Parser Command end = End . End.Options <$> switch (mconcat [ long "force", short 'f' , help "Force the game to end" ]) heal :: Parser Command heal = pure Heal help_ :: Parser Command help_ = Help . Help.Options <$> optional (subparser $ mconcat [ command "commands" $ info (Help.Commands <$> allOption) (fullDesc <> progDesc "Print the in-game commands") , command "roles" $ info (Help.Roles <$> allOption) (fullDesc <> progDesc "Print the roles and their descriptions") , command "rules" $ info (Help.Rules <$> allOption) (fullDesc <> progDesc "Print the game rules") ]) where allOption = switch $ long "all" <> short 'a' interpret :: Parser Command interpret = Interpret . Interpret.Options <$> many (T.pack <$> strArgument (metavar "-- COMMAND ARG...")) pass :: Parser Command pass = pure Pass ping :: Parser Command ping = pure Ping poison :: Parser Command poison = Poison . Poison.Options <$> playerArgument protect :: Parser Command protect = Protect . Protect.Options <$> playerArgument quit :: Parser Command quit = pure Quit see :: Parser Command see = See . See.Options <$> playerArgument start :: Parser Command start = fmap Start $ Start.Options <$> (extraRolesOption <|> randomExtraRolesOption) <*> switch (mconcat [ long "include-seer" , help "Always include the Seer" ]) <*> some (T.pack <$> strArgument (metavar "PLAYER...")) where extraRolesOption = fmap (Start.Use . filter (/= T.empty) . T.splitOn "," . T.pack) (strOption $ mconcat [ long "extra-roles", short 'e', metavar "ROLE,..." , value [] , help "Specify the extra roles to use" ]) randomExtraRolesOption = flag Start.None Start.Random $ mconcat [ long "random-extra-roles", short 'r' , help "Use random extra roles" ] status :: Parser Command status = pure Status version :: Parser Command version = pure Version vote :: Parser Command vote = Vote . Vote.Options <$> playerArgument playerArgument :: Parser Text playerArgument = T.pack <$> strArgument (metavar "PLAYER")