{-# LANGUAGE ApplicativeDo #-}
-- | Parsing of commandline arguments.
module Game.LambdaHack.Server.Commandline
  ( serverOptionsPI
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , serverOptionsP
      -- other internal operations too numerous and changing, so not listed
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude
-- Cabal
import qualified Paths_LambdaHack as Self (version)

import qualified Data.Text as T
import           Data.Version
import           Options.Applicative
import qualified System.Random.SplitMix32 as SM

-- Dependence on ClientOptions is an anomaly. Instead, probably the raw
-- remaining commandline should be passed and parsed by the client to extract
-- client and ui options from and singnal an error if anything was left.

import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.ServerOptions

-- | Parser for server options from commandline arguments.
serverOptionsPI :: ParserInfo ServerOptions
serverOptionsPI :: ParserInfo ServerOptions
serverOptionsPI = Parser ServerOptions
-> InfoMod ServerOptions -> ParserInfo ServerOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ServerOptions
serverOptionsP Parser ServerOptions
-> Parser (ServerOptions -> ServerOptions) -> Parser ServerOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ServerOptions -> ServerOptions)
forall a. Parser (a -> a)
helper Parser ServerOptions
-> Parser (ServerOptions -> ServerOptions) -> Parser ServerOptions
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ServerOptions -> ServerOptions)
forall a. Parser (a -> a)
version)
                  (InfoMod ServerOptions -> ParserInfo ServerOptions)
-> InfoMod ServerOptions -> ParserInfo ServerOptions
forall a b. (a -> b) -> a -> b
$ InfoMod ServerOptions
forall a. InfoMod a
fullDesc
                    InfoMod ServerOptions
-> InfoMod ServerOptions -> InfoMod ServerOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod ServerOptions
forall a. String -> InfoMod a
progDesc "Configure debug options here, gameplay options in configuration file."

version :: Parser (a -> a)
version :: Parser (a -> a)
version = String -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. String -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (Version -> String
showVersion Version
Self.version)
  (String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "version"
   Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
help "Print engine version information")

serverOptionsP :: Parser ServerOptions
serverOptionsP :: Parser ServerOptions
serverOptionsP = do
  ~(snewGameSer :: Bool
snewGameSer, scurChalSer :: Challenge
scurChalSer)
                    <- Maybe Int -> (Bool, Challenge)
serToChallenge (Maybe Int -> (Bool, Challenge))
-> Parser (Maybe Int) -> Parser (Bool, Challenge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Int)
newGameP
  Maybe FullscreenMode
sfullscreenMode   <- Parser (Maybe FullscreenMode)
fullscreenModeP
  Bool
knowMap           <- Parser Bool
knowMapP
  Bool
knowEvents        <- Parser Bool
knowEventsP
  Bool
knowItems         <- Parser Bool
knowItemsP
  Bool
showItemSamples   <- Parser Bool
showItemSamplesP
  Bool
sexposePlaces     <- Parser Bool
exposePlacesP
  Bool
sexposeItems      <- Parser Bool
exposeItemsP
  Bool
sexposeActors     <- Parser Bool
exposeActorsP
  Bool
sniff             <- Parser Bool
sniffP
  Bool
sallClear         <- Parser Bool
allClearP
  Bool
sboostRandomItem  <- Parser Bool
boostRandItemP
  Maybe (GroupName ModeKind)
sgameMode         <- Parser (Maybe (GroupName ModeKind))
gameModeP
  Bool
sautomateAll      <- Parser Bool
automateAllP
  Bool
skeepAutomated    <- Parser Bool
keepAutomatedP
  Maybe Int
sstopAfterSeconds <- Parser (Maybe Int)
stopAfterSecsP
  Maybe Int
sstopAfterFrames  <- Parser (Maybe Int)
stopAfterFramesP
  Bool
sstopAfterGameOver <- Parser Bool
stopAfterGameOverP
  Bool
sprintEachScreen  <- Parser Bool
printEachScreenP
  Bool
sbenchmark        <- Parser Bool
benchmarkP
  Maybe SMGen
sdungeonRng       <- Parser (Maybe SMGen)
setDungeonRngP
  Maybe SMGen
smainRng          <- Parser (Maybe SMGen)
setMainRngP
  Bool
sdumpInitRngs     <- Parser Bool
dumpInitRngsP
  Bool
sdbgMsgSer        <- Parser Bool
dbgMsgSerP
  Maybe Int
sassertExplored   <- Parser (Maybe Int)
assertExploredP
  Maybe Text
schosenFontset    <- Parser (Maybe Text)
chosenFontsetP
  Maybe Double
sallFontsScale    <- Parser (Maybe Double)
allFontsScaleP
  Maybe Int
slogPriority      <- Parser (Maybe Int)
logPriorityP
  Maybe Double
smaxFps           <- Parser (Maybe Double)
maxFpsP
  Bool
sdisableAutoYes   <- Parser Bool
disableAutoYesP
  Maybe Bool
snoAnim           <- Parser (Maybe Bool)
noAnimP
  String
ssavePrefixSer    <- Parser String
savePrefixP
  Bool
sfrontendTeletype <- Parser Bool
frontendTeletypeP
  Bool
sfrontendNull     <- Parser Bool
frontendNullP
  Bool
sfrontendLazy     <- Parser Bool
frontendLazyP
  Bool
sdbgMsgCli        <- Parser Bool
dbgMsgCliP

  pure $WServerOptions :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe (GroupName ModeKind)
-> Bool
-> Bool
-> Maybe SMGen
-> Maybe SMGen
-> Bool
-> Challenge
-> Bool
-> String
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> ClientOptions
-> ServerOptions
ServerOptions
    {
      sclientOptions :: ClientOptions
sclientOptions = $WClientOptions :: Maybe Text
-> Maybe Double
-> [(Text, FontDefinition)]
-> [(Text, FontSet)]
-> Maybe FullscreenMode
-> Maybe Int
-> Maybe Double
-> Bool
-> Maybe Bool
-> Bool
-> Bool
-> Maybe String
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe Int
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Bool
-> ClientOptions
ClientOptions
        { sfonts :: [(Text, FontDefinition)]
sfonts         = []  -- comes only from config file
        , sfontsets :: [(Text, FontSet)]
sfontsets      = []  -- comes only from config file
        , stitle :: Maybe String
stitle         = Maybe String
forall a. Maybe a
Nothing
        , snewGameCli :: Bool
snewGameCli    = Bool
snewGameSer
        , ssavePrefixCli :: String
ssavePrefixCli = String
ssavePrefixSer
        , ..
        }
    , sknowMap :: Bool
sknowMap = Bool
knowMap Bool -> Bool -> Bool
|| Bool
knowEvents Bool -> Bool -> Bool
|| Bool
knowItems
    , sknowEvents :: Bool
sknowEvents = Bool
knowEvents Bool -> Bool -> Bool
|| Bool
knowItems
    , sknowItems :: Bool
sknowItems = Bool
knowItems
    , sshowItemSamples :: Bool
sshowItemSamples = Bool -> Bool
not (Bool
knowEvents Bool -> Bool -> Bool
|| Bool
knowItems) Bool -> Bool -> Bool
&& Bool
showItemSamples
    , ..
    }
 where
   serToChallenge :: Maybe Int -> (Bool, Challenge)
   serToChallenge :: Maybe Int -> (Bool, Challenge)
serToChallenge Nothing      = (Bool
False, Challenge
defaultChallenge)
   serToChallenge (Just cdiff :: Int
cdiff) = (Bool
True, Challenge
defaultChallenge {Int
cdiff :: Int
cdiff :: Int
cdiff})

knowMapP :: Parser Bool
knowMapP :: Parser Bool
knowMapP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "knowMap"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Reveal map for all clients in the next game" )

knowEventsP :: Parser Bool
knowEventsP :: Parser Bool
knowEventsP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "knowEvents"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Show all events in the next game (implies --knowMap)" )

knowItemsP :: Parser Bool
knowItemsP :: Parser Bool
knowItemsP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "knowItems"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Auto-identify all items in the next game (implies --knowEvents)" )

exposePlacesP :: Parser Bool
exposePlacesP :: Parser Bool
exposePlacesP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "exposePlaces"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Expose all possible places in the next game" )

exposeItemsP :: Parser Bool
exposeItemsP :: Parser Bool
exposeItemsP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "exposeItems"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Expose all possible items in the next game" )

exposeActorsP :: Parser Bool
exposeActorsP :: Parser Bool
exposeActorsP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "exposeActors"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Expose all killable actors in the next game" )

showItemSamplesP :: Parser Bool
showItemSamplesP :: Parser Bool
showItemSamplesP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "showItemSamples"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "At game over show samples of all items (--knowEvents disables this)" )

sniffP :: Parser Bool
sniffP :: Parser Bool
sniffP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "sniff"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Monitor all trafic between server and clients" )

allClearP :: Parser Bool
allClearP :: Parser Bool
allClearP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "allClear"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Let all map tiles be translucent" )

boostRandItemP :: Parser Bool
boostRandItemP :: Parser Bool
boostRandItemP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "boostRandomItem"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Pick a random item and make it very common" )

gameModeP :: Parser (Maybe (GroupName ModeKind))
gameModeP :: Parser (Maybe (GroupName ModeKind))
gameModeP = Parser (GroupName ModeKind) -> Parser (Maybe (GroupName ModeKind))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser (GroupName ModeKind)
 -> Parser (Maybe (GroupName ModeKind)))
-> Parser (GroupName ModeKind)
-> Parser (Maybe (GroupName ModeKind))
forall a b. (a -> b) -> a -> b
$ String -> GroupName ModeKind
toGameMode (String -> GroupName ModeKind)
-> Parser String -> Parser (GroupName ModeKind)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM String -> Mod OptionFields String -> Parser String
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM String
nonEmptyStr
         (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "gameMode"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "MODE"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help "Start next game in the scenario indicated by MODE" )
 where
  -- This ignores all but the first word of a game mode name
  -- and assumes the fist word is present among its frequencies.
  toGameMode :: String -> GroupName ModeKind
  toGameMode :: String -> GroupName ModeKind
toGameMode = Text -> GroupName ModeKind
forall a. Text -> GroupName a
GroupName (Text -> GroupName ModeKind)
-> (String -> Text) -> String -> GroupName ModeKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> (String -> [Text]) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words (Text -> [Text]) -> (String -> Text) -> String -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  nonEmptyStr :: ReadM String
  nonEmptyStr :: ReadM String
nonEmptyStr = (String -> Either String String) -> ReadM String
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String String) -> ReadM String)
-> (String -> Either String String) -> ReadM String
forall a b. (a -> b) -> a -> b
$ \case
    "" -> String -> Either String String
forall a b. a -> Either a b
Left "name of game mode cannot be empty"
    ns :: String
ns -> String -> Either String String
forall a b. b -> Either a b
Right String
ns

automateAllP :: Parser Bool
automateAllP :: Parser Bool
automateAllP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "automateAll"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Give control of all UI teams to computer" )

keepAutomatedP :: Parser Bool
keepAutomatedP :: Parser Bool
keepAutomatedP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "keepAutomated"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Keep factions automated after game over" )

newGameP :: Parser (Maybe Int)
newGameP :: Parser (Maybe Int)
newGameP = Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
difficultyBound (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "newGame"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help "Start a new game, overwriting the save file, with difficulty for all UI players set to N"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "N" )

fullscreenModeP :: Parser (Maybe FullscreenMode)
fullscreenModeP :: Parser (Maybe FullscreenMode)
fullscreenModeP = Parser FullscreenMode -> Parser (Maybe FullscreenMode)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FullscreenMode -> Parser (Maybe FullscreenMode))
-> Parser FullscreenMode -> Parser (Maybe FullscreenMode)
forall a b. (a -> b) -> a -> b
$
  ReadM FullscreenMode
-> Mod OptionFields FullscreenMode -> Parser FullscreenMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM FullscreenMode
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields FullscreenMode
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "fullscreenMode"
              Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields FullscreenMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'f'
              Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields FullscreenMode
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "MODE"
              Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
-> Mod OptionFields FullscreenMode
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields FullscreenMode
forall (f :: * -> *) a. String -> Mod f a
help "Display in MODE, one of NotFullscreen (default), BigBorderlessWindow (preferred), ModeChange" )

stopAfterSecsP :: Parser (Maybe Int)
stopAfterSecsP :: Parser (Maybe Int)
stopAfterSecsP = Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "stopAfterSeconds"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help "Exit game session after around N seconds"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "N" )

stopAfterFramesP :: Parser (Maybe Int)
stopAfterFramesP :: Parser (Maybe Int)
stopAfterFramesP = Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "stopAfterFrames"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help "Exit game session after around N frames"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "N" )

stopAfterGameOverP :: Parser Bool
stopAfterGameOverP :: Parser Bool
stopAfterGameOverP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "stopAfterGameOver"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Exit the application after game over" )

printEachScreenP :: Parser Bool
printEachScreenP :: Parser Bool
printEachScreenP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "printEachScreen"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Take a screenshot of each rendered distinct frame (SDL only)" )

benchmarkP :: Parser Bool
benchmarkP :: Parser Bool
benchmarkP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "benchmark"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Restrict file IO, print timing stats" )

setDungeonRngP :: Parser (Maybe SM.SMGen)
setDungeonRngP :: Parser (Maybe SMGen)
setDungeonRngP = Parser SMGen -> Parser (Maybe SMGen)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser SMGen -> Parser (Maybe SMGen))
-> Parser SMGen -> Parser (Maybe SMGen)
forall a b. (a -> b) -> a -> b
$
  ReadM SMGen -> Mod OptionFields SMGen -> Parser SMGen
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM SMGen
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields SMGen
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "setDungeonRng"
              Mod OptionFields SMGen
-> Mod OptionFields SMGen -> Mod OptionFields SMGen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SMGen
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "RNG_SEED"
              Mod OptionFields SMGen
-> Mod OptionFields SMGen -> Mod OptionFields SMGen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SMGen
forall (f :: * -> *) a. String -> Mod f a
help "Set dungeon generation RNG seed to string RNG_SEED" )

setMainRngP :: Parser (Maybe SM.SMGen)
setMainRngP :: Parser (Maybe SMGen)
setMainRngP = Parser SMGen -> Parser (Maybe SMGen)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser SMGen -> Parser (Maybe SMGen))
-> Parser SMGen -> Parser (Maybe SMGen)
forall a b. (a -> b) -> a -> b
$
  ReadM SMGen -> Mod OptionFields SMGen -> Parser SMGen
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM SMGen
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields SMGen
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "setMainRng"
              Mod OptionFields SMGen
-> Mod OptionFields SMGen -> Mod OptionFields SMGen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SMGen
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "RNG_SEED"
              Mod OptionFields SMGen
-> Mod OptionFields SMGen -> Mod OptionFields SMGen
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields SMGen
forall (f :: * -> *) a. String -> Mod f a
help "Set the main game RNG seed to string RNG_SEED" )

dumpInitRngsP :: Parser Bool
dumpInitRngsP :: Parser Bool
dumpInitRngsP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "dumpInitRngs"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Dump the RNG seeds used to initialize the game" )

dbgMsgSerP :: Parser Bool
dbgMsgSerP :: Parser Bool
dbgMsgSerP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "dbgMsgSer"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Emit extra internal server debug messages" )

assertExploredP :: Parser (Maybe Int)
assertExploredP :: Parser (Maybe Int)
assertExploredP = Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 (Int -> Int) -> Parser Int -> Parser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "assertExplored"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help "Check that when the session ends, the indicated level has been explored"
              Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "N" )

chosenFontsetP :: Parser (Maybe Text)
chosenFontsetP :: Parser (Maybe Text)
chosenFontsetP = Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text -> Parser (Maybe Text))
-> Parser Text -> Parser (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> Parser String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "fontset"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "FONTSET_ID"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help "Render UI using the given fontset from config file" )

allFontsScaleP :: Parser (Maybe Double)
allFontsScaleP :: Parser (Maybe Double)
allFontsScaleP = Parser Double -> Parser (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Double -> Parser (Maybe Double))
-> Parser Double -> Parser (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "allFontsScale"
              Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "D"
              Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
help "Scale all fonts by D, resizing the whole UI" )

maxFpsP :: Parser (Maybe Double)
maxFpsP :: Parser (Maybe Double)
maxFpsP = Parser Double -> Parser (Maybe Double)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Double -> Parser (Maybe Double))
-> Parser Double -> Parser (Maybe Double)
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double) -> Parser Double -> Parser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Double
forall a. Read a => ReadM a
auto (  String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "maxFps"
              Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "D"
              Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
help "Display at most D frames per second" )

logPriorityP :: Parser (Maybe Int)
logPriorityP :: Parser (Maybe Int)
logPriorityP = Parser Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Int -> Parser (Maybe Int))
-> Parser Int -> Parser (Maybe Int)
forall a b. (a -> b) -> a -> b
$
  ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (ReadM Int
forall a. Read a => ReadM a
auto ReadM Int -> (Int -> ReadM Int) -> ReadM Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ReadM Int
forall a. (Ord a, Num a) => a -> ReadM a
verifyLogPriority) (Mod OptionFields Int -> Parser Int)
-> Mod OptionFields Int -> Parser Int
forall a b. (a -> b) -> a -> b
$
       String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "logPriority"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields Int
forall a (f :: * -> *). Show a => Mod f a
showDefault
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value 5
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "N"
    Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help ( "Log only messages of priority at least N, where 1 (all) is "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "the lowest and 5 logs errors only; use value 0 for testing on "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "CIs without graphics access; setting priority to 0 causes "
           String -> String -> String
forall a. [a] -> [a] -> [a]
++ "SDL frontend to init and quit at once" )
  where
    verifyLogPriority :: a -> ReadM a
verifyLogPriority n :: a
n =
      if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= 5
      then a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
n
      else String -> ReadM a
forall a. String -> ReadM a
readerError "N has to be 0 or a positive integer not larger than 5"

disableAutoYesP :: Parser Bool
disableAutoYesP :: Parser Bool
disableAutoYesP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "disableAutoYes"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Never auto-answer prompts, not even when UI faction is automated" )

noAnimP :: Parser (Maybe Bool)
noAnimP :: Parser (Maybe Bool)
noAnimP =
  Maybe Bool
-> Maybe Bool -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool)
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Maybe Bool
forall a. Maybe a
Nothing (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
       (  String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "noAnim"
       Mod FlagFields (Maybe Bool)
-> Mod FlagFields (Maybe Bool) -> Mod FlagFields (Maybe Bool)
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields (Maybe Bool)
forall (f :: * -> *) a. String -> Mod f a
help "Don't show any animations" )

savePrefixP :: Parser String
savePrefixP :: Parser String
savePrefixP =
  Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (  String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "savePrefix"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar "PREFIX"
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
forall a (f :: * -> *). Show a => Mod f a
showDefault
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ""
            Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help "Prepend PREFIX to all savefile names" )

frontendTeletypeP :: Parser Bool
frontendTeletypeP :: Parser Bool
frontendTeletypeP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "frontendTeletype"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Use the line terminal frontend (for tests)" )

frontendNullP :: Parser Bool
frontendNullP :: Parser Bool
frontendNullP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "frontendNull"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Use frontend with no display (for benchmarks)" )

frontendLazyP :: Parser Bool
frontendLazyP :: Parser Bool
frontendLazyP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "frontendLazy"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Use frontend that not even computes frames (for benchmarks)" )

dbgMsgCliP :: Parser Bool
dbgMsgCliP :: Parser Bool
dbgMsgCliP =
  Mod FlagFields Bool -> Parser Bool
switch (  String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long "dbgMsgCli"
         Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help "Emit extra internal client debug messages" )