content: {-# LANGUAGE ApplicativeDo #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE TemplateHaskell #-}
  
  -- |
  -- SPDX-License-Identifier: BSD-3-Clause
  module Main (main) where
  
  import Control.Monad (when)
  import Data.Foldable qualified
  import Data.List.Extra (enumerate)
  import Data.Set qualified as Set
  import Data.Text.IO qualified as T
  import GitHash (GitInfo, giBranch, giHash, tGitInfoCwdTry)
  import Options.Applicative
  import Options.Applicative.Help hiding (color, fullDesc)
  import Swarm.App (appMain, defaultMetrics)
  import Swarm.Language.Format
  import Swarm.Language.LSP (lspMain)
  import Swarm.Language.Parser.Core (LanguageVersion (..))
  import Swarm.ResourceLoading (getSwarmConfigIniFile)
  import Swarm.TUI.Model (AppOpts (..), ColorMode (..), RunOpts (..))
  import Swarm.TUI.Model.DebugOption
  import Swarm.TUI.Model.KeyBindings (KeybindingPrint (..), showKeybindings)
  import Swarm.TUI.Model.UI (defaultInitLgTicksPerSecond)
  import Swarm.Version
  import Swarm.Web (defaultPort)
  import System.IO (hPrint, stderr)
  import Text.Read (readMaybe)
  
  gitInfo :: Maybe GitInfo
  gitInfo = either (const Nothing) Just $$tGitInfoCwdTry
  
  commitInfo :: String
  commitInfo = case gitInfo of
    Nothing -> ""
    Just git -> " (" <> giBranch git <> "@" <> take 10 (giHash git) <> ")"
  
  data CLI
    = Run AppOpts
    | -- | Print list of bindings, optionally initializing the INI configuration file.
      ListKeybinding Bool KeybindingPrint
    | Format FormatConfig
    | LSP
    | Version
  
  cliParser :: Parser CLI
  cliParser =
    subparser
      ( mconcat
          [ command "run" (info (Run <$> appOpts <**> helper) (progDesc "Run the Swarm game (default)"))
          , command "format" (info (Format <$> parseFormat) (progDesc "Format a file"))
          , command "lsp" (info (pure LSP) (progDesc "Start the LSP"))
          , command "version" (info (pure Version) (progDesc "Get current and upstream version."))
          , command "keybindings" (info (ListKeybinding <$> initKeybindingConfig <*> printKeyMode <**> helper) (progDesc "List the keybindings"))
          ]
      )
      <|> Run <$> appOpts
   where
    appOpts :: Parser AppOpts
    appOpts = do
      let repoGitInfo = gitInfo
      userSeed <- seed
      userScenario <- scenario
      runOpts <- run <|> replay <|> autoplay
      pausedAtStart <- paused
      autoShowObjectives <- not <$> hideGoal
      speed <- speedFactor
      debugOptions <- debug
      cheatMode <- cheat
      colorMode <- color
      userWebPort <- webPort
      userMetricsPort <- metricsPort
      -- ApplicativeDo does not give Monad powers, so cheat is added here
      return $ addToDebug cheatMode $ AppOpts {..}
  
    addToDebug :: Set.Set DebugOption -> AppOpts -> AppOpts
    addToDebug cheatMode ao = ao {debugOptions = cheatMode `Set.union` debugOptions ao}
  
    input :: Parser FormatInput
    input =
      flag' Stdin (long "stdin" <> help "Read code from stdin")
        <|> (InputFile <$> strArgument (metavar "FILE"))
  
    output :: Parser FormatOutput
    output =
      flag Stdout Stdout (long "stdout" <> help "Write formatted code to stdout (default)")
        <|> (OutputFile <$> strOption (long "output" <> short 'o' <> metavar "FILE" <> help "Write formatted code to an output file"))
        <|> flag' Inplace (long "inplace" <> short 'i' <> help "Format file in place")
  
    widthOpt :: Parser FormatWidth
    widthOpt = option auto (long "width" <> metavar "COLUMNS" <> help "Use layout with maximum width")
  
    langVer :: Parser LanguageVersion
    langVer = flag SwarmLangLatest SwarmLang0_6 (long "v0.6" <> help "Read (& convert) code from Swarm version 0.6")
  
    printKeyMode :: Parser KeybindingPrint
    printKeyMode =
      flag' IniPrint (long "ini" <> help "Print in INI format")
        <|> flag' MarkdownPrint (long "markdown" <> help "Print in Markdown table format")
        <|> pure TextPrint
  
    initKeybindingConfig :: Parser Bool
    initKeybindingConfig = switch (short 'i' <> long "init" <> help "Initialise the keybindings configuration file")
  
    parseFormat :: Parser FormatConfig
    parseFormat = FormatConfig <$> input <*> output <*> optional widthOpt <*> langVer <**> helper
  
    seed :: Parser (Maybe Int)
    seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")
  
    webPort :: Parser (Maybe Int)
    webPort =
      optional $
        option
          auto
          ( long "web"
              <> metavar "PORT"
              <> help ("Set the web service port (or disable it with 0). Default to " <> show defaultPort <> ".")
          )
  
    metricsPort :: Parser (Maybe Int)
    metricsPort =
      optional $
        option
          auto
          ( long "metrics"
              <> metavar "PORT"
              <> help ("Set the metrics port (or disable it with 0). Default to " <> show defaultMetrics <> ".")
          )
  
    scenario :: Parser (Maybe String)
    scenario = optional $ strOption (long "scenario" <> short 'i' <> metavar "FILE" <> help "Name of an input scenario to load")
    run :: Parser (Maybe RunOpts)
    run = optional $ RunScript <$> strOption (long "run" <> short 'r' <> metavar "FILE" <> help "Run the commands in a file at startup")
    replay :: Parser (Maybe RunOpts)
    replay = optional $ Replay <$> strOption (long "replay" <> metavar "JSON" <> help "Replay the previous command history.")
    autoplay :: Parser (Maybe RunOpts)
    autoplay = ifAuto <$> switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.")
    ifAuto b = if b then Just AutoPlay else Nothing
    paused :: Parser Bool
    paused = switch (long "paused" <> short 'p' <> help "Pause the game at start.")
    hideGoal :: Parser Bool
    hideGoal = switch (long "hide-goal" <> help "Do not show goal modal window that pauses the game.")
    speedFactor :: Parser Int
    speedFactor = option auto (long "speed" <> short 'm' <> metavar "N" <> value defaultInitLgTicksPerSecond <> help speedFactorHelp)
    speedFactorHelp =
      unwords
        [ "Initial game speed."
        , "Counted as 2^N ticks per second, default is"
        , show defaultInitLgTicksPerSecond
        , "meaning"
        , show $ 2 ** fromIntegral @Int @Double defaultInitLgTicksPerSecond
        , "t/s."
        , "(Negative values are allowed, e.g. -3 means 1 tick per 8 sec.)"
        ]
  
    debug :: Parser (Set.Set DebugOption)
    debug = Set.unions <$> many debugOption
    debugOption :: Parser (Set.Set DebugOption)
    debugOption =
      option
        debugOptionList
        ( long "debug"
            <> short 'd'
            <> metavar "OPTS"
            <> hidden
            <> helpDoc debugOptionHelp
            <> completeWith debugCompletions
        )
    debugCompletions = "all" : map debugOptionName enumerate
    debugOptionList :: ReadM (Set.Set DebugOption)
    debugOptionList = eitherReader $ \case
      "all" -> pure $ Set.fromAscList enumerate
      opts -> Set.fromList <$> readDebugOptionList opts
    debugOptionHelp :: Maybe Doc
    debugOptionHelp =
      Just . nest 2 . vsep $
        "Use 'all' or a comma separated list of options:"
          : [ fillBreak 20 ("*" <+> pretty name) <+> pretty desc
            | o <- enumerate
            , let name = debugOptionName o
            , let desc = debugOptionDescription o
            ]
    cheat :: Parser (Set.Set DebugOption)
    cheat = flag mempty (Set.singleton ToggleCreative) (long "cheat" <> short 'x' <> helpDoc (Just cheatHelp))
    cheatHelp =
      "Enable cheat mode."
        <+> pretty ("This is an alias for --debug=" <> debugOptionName ToggleCreative)
  
    color :: Parser (Maybe ColorMode)
    color = optional $ option colorModeParser (long "color" <> short 'c' <> metavar "MODE" <> help "Use none/8/16/full color mode.")
    colorModeParser =
      Data.Foldable.asum
        [ ColorMode8 <$ text "8"
        , ColorMode16 <$ text "16"
        , ColorMode240 <$> maybeReader (\case ('2' : '4' : '0' : '_' : w) -> readMaybe w; _ -> Nothing)
        , FullColor <$ text "full"
        , NoColor <$ text "none"
        ]
    text t = maybeReader (\x -> if x == t then Just x else Nothing)
  
  cliInfo :: ParserInfo CLI
  cliInfo =
    info
      (cliParser <**> helper)
      ( header ("Swarm game - " <> version <> commitInfo)
          <> progDesc "To play the game simply run without any command."
          <> fullDesc
      )
  
  showVersion :: IO ()
  showVersion = do
    putStrLn $ "Swarm game - " <> version <> commitInfo
    up <- getNewerReleaseVersion gitInfo
    either (hPrint stderr) (putStrLn . ("New upstream release: " <>)) up
  
  printKeybindings :: Bool -> KeybindingPrint -> IO ()
  printKeybindings initialize p = do
    kb <- showKeybindings p
    T.putStrLn kb
    (iniExists, ini) <- getSwarmConfigIniFile initialize
    when initialize $ do
      kbi <- showKeybindings IniPrint
      T.writeFile ini kbi
    let iniState
          | iniExists && initialize = "has been updated"
          | iniExists = "is"
          | initialize = "has been created"
          | otherwise = "can be created (--init)"
    putStrLn $ replicate 80 '-'
    putStrLn $ "The configuration file " <> iniState <> " at:"
    putStrLn ini
  
  main :: IO ()
  main = do
    cli <- execParser cliInfo
    case cli of
      Run opts -> appMain opts
      ListKeybinding initialize p -> printKeybindings initialize p
      Format cfg -> formatSwarmIO cfg
      LSP -> lspMain
      Version -> showVersion
  