{-# 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 qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal
import           Game.LambdaHack.Server.ServerOptions

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

version :: Parser (a -> a)
version = infoOption (showVersion Self.version)
  (long "version"
   <> help "Print engine version information")

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

  pure ServerOptions
    {
      sclientOptions = ClientOptions
        { sfonts         = []  -- comes only from config file
        , sfontsets      = []  -- comes only from config file
        , stitle         = Nothing
        , snewGameCli    = snewGameSer
        , ssavePrefixCli = ssavePrefixSer
        , ..
        }
    , sknowMap = knowMap || knowEvents || knowItems
    , sknowEvents = knowEvents || knowItems
    , sknowItems = knowItems
    , sshowItemSamples = not (knowEvents || knowItems) && showItemSamples
    , ..
    }
 where
   serToChallenge :: Maybe Int -> (Bool, Challenge)
   serToChallenge Nothing      = (False, defaultChallenge)
   serToChallenge (Just cdiff) = (True, defaultChallenge {cdiff})

knowMapP :: Parser Bool
knowMapP =
  switch (  long "knowMap"
         <> help "Reveal map for all clients in the next game" )

knowEventsP :: Parser Bool
knowEventsP =
  switch (  long "knowEvents"
         <> help "Show all events in the next game (implies --knowMap)" )

knowItemsP :: Parser Bool
knowItemsP =
  switch (  long "knowItems"
         <> help "Auto-identify all items in the next game (implies --knowEvents)" )

exposePlacesP :: Parser Bool
exposePlacesP =
  switch (  long "exposePlaces"
         <> help "Expose all possible places in the next game" )

exposeItemsP :: Parser Bool
exposeItemsP =
  switch (  long "exposeItems"
         <> help "Expose all possible items in the next game" )

exposeActorsP :: Parser Bool
exposeActorsP =
  switch (  long "exposeActors"
         <> help "Expose all killable actors in the next game" )

showItemSamplesP :: Parser Bool
showItemSamplesP =
  switch (  long "showItemSamples"
         <> help "At game over show samples of all items (--knowEvents disables this)" )

sniffP :: Parser Bool
sniffP =
  switch (  long "sniff"
         <> help "Monitor all trafic between server and clients" )

allClearP :: Parser Bool
allClearP =
  switch (  long "allClear"
         <> help "Let all map tiles be translucent" )

boostRandItemP :: Parser Bool
boostRandItemP =
  switch (  long "boostRandomItem"
         <> help "Pick a random item and make it very common" )

gameModeP :: Parser (Maybe (GroupName ModeKind))
gameModeP = optional $ toGameMode <$>
  option nonEmptyStr
         (  long "gameMode"
            <> metavar "MODE"
            <> 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 = DefsInternal.GroupName . head . T.words . T.pack
  nonEmptyStr :: ReadM String
  nonEmptyStr = eitherReader $ \case
    "" -> Left "name of game mode cannot be empty"
    ns -> Right ns

automateAllP :: Parser Bool
automateAllP =
  switch (  long "automateAll"
         <> help "Give control of all UI teams to computer" )

keepAutomatedP :: Parser Bool
keepAutomatedP =
  switch (  long "keepAutomated"
         <> help "Keep factions automated after game over" )

newGameP :: Parser (Maybe Int)
newGameP = optional $ max 1 . min difficultyBound <$>
  option auto (  long "newGame"
              <> help "Start a new game, overwriting the save file and often forgetting history, with difficulty for all UI players set to N"
              <> metavar "N" )

fullscreenModeP :: Parser (Maybe FullscreenMode)
fullscreenModeP = optional $
  option auto (  long "fullscreenMode"
              <> short 'f'
              <> metavar "MODE"
              <> help "Display in MODE, one of NotFullscreen (default), BigBorderlessWindow (preferred), ModeChange" )

stopAfterSecsP :: Parser (Maybe Int)
stopAfterSecsP = optional $ max 0 <$>
  option auto (  long "stopAfterSeconds"
              <> help "Exit game session after around N seconds"
              <> metavar "N" )

stopAfterFramesP :: Parser (Maybe Int)
stopAfterFramesP = optional $ max 0 <$>
  option auto (  long "stopAfterFrames"
              <> help "Exit game session after around N frames"
              <> metavar "N" )

stopAfterGameOverP :: Parser Bool
stopAfterGameOverP =
  switch (  long "stopAfterGameOver"
         <> help "Exit the application after game over" )

printEachScreenP :: Parser Bool
printEachScreenP =
  switch (  long "printEachScreen"
         <> help "Take a screenshot of each rendered distinct frame (SDL only)" )

benchmarkP :: Parser Bool
benchmarkP =
  switch (  long "benchmark"
         <> help "Restrict file IO, print timing stats" )

benchMessagesP :: Parser Bool
benchMessagesP =
  switch (  long "benchMessages"
         <> help "Display messages in realistic was under AI control (for benchmarks)" )

setDungeonRngP :: Parser (Maybe SM.SMGen)
setDungeonRngP = optional $
  option auto (  long "setDungeonRng"
              <> metavar "RNG_SEED"
              <> help "Set dungeon generation RNG seed to string RNG_SEED" )

setMainRngP :: Parser (Maybe SM.SMGen)
setMainRngP = optional $
  option auto (  long "setMainRng"
              <> metavar "RNG_SEED"
              <> help "Set the main game RNG seed to string RNG_SEED" )

dumpInitRngsP :: Parser Bool
dumpInitRngsP =
  switch (  long "dumpInitRngs"
         <> help "Dump the RNG seeds used to initialize the game" )

dbgMsgCliP :: Parser Bool
dbgMsgCliP =
  switch (  long "dbgMsgCli"
         <> help "Emit extra internal client debug messages" )

dbgMsgSerP :: Parser Bool
dbgMsgSerP =
  switch (  long "dbgMsgSer"
         <> help "Emit extra internal server debug messages" )

logPriorityP :: Parser (Maybe Int)
logPriorityP = optional $
  option (auto >>= verifyLogPriority) $
       long "logPriority"
    <> showDefault
    <> value 5
    <> metavar "N"
    <> help ( "Log only messages of priority at least N, where 1 (all) is "
           ++ "the lowest and 5 logs errors only; use value 0 for testing on "
           ++ "CIs without graphics access; setting priority to 0 causes "
           ++ "SDL frontend to init and quit at once" )
  where
    verifyLogPriority n =
      if n >= 0 && n <= 5
      then return n
      else readerError "N has to be 0 or a positive integer not larger than 5"

assertExploredP :: Parser (Maybe Int)
assertExploredP = optional $ max 1 <$>
  option auto (  long "assertExplored"
              <> help "Check that when the session ends, the indicated level has been explored"
              <> metavar "N" )

chosenFontsetP :: Parser (Maybe Text)
chosenFontsetP = optional $ T.pack <$>
  strOption (  long "fontset"
            <> metavar "FONTSET_ID"
            <> help "Render UI using the given fontset from config file" )

allFontsScaleP :: Parser (Maybe Double)
allFontsScaleP = optional $ max 0 <$>
  option auto (  long "allFontsScale"
              <> metavar "D"
              <> help "Scale all fonts by D, resizing the whole UI" )

maxFpsP :: Parser (Maybe Double)
maxFpsP = optional $ max 0 <$>
  option auto (  long "maxFps"
              <> metavar "D"
              <> help "Display at most D frames per second" )

disableAutoYesP :: Parser Bool
disableAutoYesP =
  switch (  long "disableAutoYes"
         <> help "Never auto-answer prompts, not even when UI faction is automated" )

noAnimP :: Parser (Maybe Bool)
noAnimP =
  flag Nothing (Just True)
       (  long "noAnim"
       <> help "Don't show any animations" )

savePrefixP :: Parser String
savePrefixP =
  strOption (  long "savePrefix"
            <> metavar "PREFIX"
            <> showDefault
            <> value ""
            <> help "Prepend PREFIX to all savefile names" )

frontendANSIP :: Parser Bool
frontendANSIP =
  switch (  long "frontendANSI"
         <> help "Use the ANSI terminal frontend (best for screen readers)" )

frontendTeletypeP :: Parser Bool
frontendTeletypeP =
  switch (  long "frontendTeletype"
         <> help "Use the line terminal frontend (for tests)" )

frontendNullP :: Parser Bool
frontendNullP =
  switch (  long "frontendNull"
         <> help "Use frontend with no display (for benchmarks)" )

frontendLazyP :: Parser Bool
frontendLazyP =
  switch (  long "frontendLazy"
         <> help "Use frontend that not even computes frames (for benchmarks)" )