content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RecordWildCards #-}
  
  -- |
  -- SPDX-License-Identifier: BSD-3-Clause
  module Swarm.TUI.Model.StateUpdate (
    initAppState,
    initPersistentState,
    constructAppState,
    initAppStateForScenario,
    classicGame0,
    startGame,
    startGameWithSeed,
    restartGame,
    attainAchievement,
    attainAchievement',
    getScenarioInfoFromPath,
    scenarioToAppState,
    animMgrTickDuration,
    PersistentState (..),
  ) where
  
  import Brick.Animation (startAnimationManager)
  import Brick.AttrMap (applyAttrMappings)
  import Brick.BChan (BChan, newBChan)
  import Brick.Focus
  import Brick.Widgets.List qualified as BL
  import Control.Arrow ((&&&))
  import Control.Carrier.Accum.Strict (runAccum)
  import Control.Carrier.State.Strict (State, execState)
  import Control.Effect.Accum
  import Control.Effect.Lens qualified as EL
  import Control.Effect.Lift
  import Control.Effect.Throw
  import Control.Lens hiding (from, (<.>))
  import Control.Monad (unless, void)
  import Control.Monad.Except (ExceptT (..))
  import Control.Monad.IO.Class (MonadIO (liftIO))
  import Control.Monad.State (MonadState, execStateT)
  import Data.Bifunctor (first)
  import Data.Foldable qualified as F
  import Data.List qualified as List
  import Data.List.Extra (enumerate)
  import Data.List.NonEmpty (NonEmpty (..))
  import Data.List.NonEmpty qualified as NE
  import Data.Map qualified as M
  import Data.Maybe (fromMaybe, isJust)
  import Data.Sequence (Seq)
  import Data.Set qualified as Set
  import Data.Text (Text)
  import Data.Text qualified as T
  import Data.Time (getZonedTime)
  import Data.Yaml (decodeFileEither, prettyPrintParseException)
  import Swarm.Failure (SystemFailure (..))
  import Swarm.Game.Achievement.Attainment
  import Swarm.Game.Achievement.Persistence
  import Swarm.Game.Land
  import Swarm.Game.Scenario (
    ScenarioInputs (..),
    gsiScenarioInputs,
    loadScenario,
    scenarioAttrs,
    scenarioLandscape,
    scenarioOperation,
    scenarioSolution,
    scenarioWorlds,
   )
  import Swarm.Game.Scenario.Scoring.Best
  import Swarm.Game.Scenario.Scoring.ConcreteMetrics
  import Swarm.Game.Scenario.Scoring.GenericMetrics
  import Swarm.Game.Scenario.Status
  import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
  import Swarm.Game.ScenarioInfo (
    ScenarioCollection,
    loadScenarios,
    normalizeScenarioPath,
    pathifyCollection,
    scenarioItemByPath,
    _SISingle,
   )
  import Swarm.Game.State
  import Swarm.Game.State.Initialize
  import Swarm.Game.State.Landscape
  import Swarm.Game.State.Runtime
  import Swarm.Game.State.Substate
  import Swarm.Game.Tick (TickNumber (TickNumber))
  import Swarm.Game.World (Seed)
  import Swarm.Log (LogSource (SystemLog), Severity (..))
  import Swarm.Pretty (prettyText)
  import Swarm.ResourceLoading (getSwarmHistoryPath)
  import Swarm.TUI.Editor.Model
  import Swarm.TUI.Editor.Model qualified as EM
  import Swarm.TUI.Editor.Util qualified as EU
  import Swarm.TUI.Inventory.Sorting
  import Swarm.TUI.Launch.Model (toSerializableParams)
  import Swarm.TUI.Model
  import Swarm.TUI.Model.Achievements
  import Swarm.TUI.Model.DebugOption (DebugOption (LoadTestingScenarios))
  import Swarm.TUI.Model.Dialog
  import Swarm.TUI.Model.KeyBindings
  import Swarm.TUI.Model.Name
  import Swarm.TUI.Model.Repl
  import Swarm.TUI.Model.UI
  import Swarm.TUI.Model.UI.Gameplay
  import Swarm.TUI.View.Attribute.Attr (swarmAttrMap, toAttrName)
  import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
  import Swarm.TUI.View.Robot
  import Swarm.TUI.View.Structure qualified as SR
  import Swarm.Util
  import Swarm.Util.Effect (asExceptT, withThrow)
  import System.Clock
  
  -- | The resolution at which the animation manager checks animations for updates, in miliseconds
  animMgrTickDuration :: Int
  animMgrTickDuration = 33
  
  -- | Initialize the 'AppState' from scratch.
  initAppState ::
    (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
    AppOpts ->
    Maybe (BChan AppEvent) ->
    m AppState
  initAppState opts mChan = do
    persistentState <- initPersistentState opts
    constructAppState persistentState opts mChan
  
  -- | Add some system failures to the list of messages in the
  --   'RuntimeState'.
  addWarnings :: RuntimeState -> [SystemFailure] -> RuntimeState
  addWarnings = List.foldl' logWarning
   where
    logWarning rs' w = rs' & eventLog %~ logEvent SystemLog Error "UI Loading" (prettyText w)
  
  -- | Based on the command line options, should we skip displaying the
  --   menu?
  skipMenu :: AppOpts -> Bool
  skipMenu AppOpts {..} = isJust userScenario || isRunningInitialProgram || isJust userSeed
   where
    isRunningInitialProgram = isJust runOpts
  
  mkRuntimeOptions :: AppOpts -> RuntimeOptions
  mkRuntimeOptions AppOpts {..} =
    RuntimeOptions
      { startPaused = pausedAtStart
      , pauseOnObjectiveCompletion = autoShowObjectives
      , loadTestScenarios = Set.member LoadTestingScenarios debugOptions
      }
  
  data PersistentState
    = PersistentState
        RuntimeState
        UIState
        KeyEventHandlingState
        ProgressionState
  
  -- | Initialize the more persistent parts of the app state, /i.e./ the
  --   'RuntimeState' and 'UIState'.  This is split out into a separate
  --   function so that in the integration test suite we can call this
  --   once and reuse the resulting states for all tests.
  initPersistentState ::
    (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
    AppOpts ->
    m PersistentState
  initPersistentState opts@(AppOpts {..}) = do
    (warnings :: Seq SystemFailure, PersistentState initRS initUI initKs initProg) <- runAccum mempty $ do
      rs <- initRuntimeState $ mkRuntimeOptions opts
      let showMainMenu = not (skipMenu opts)
      ui <- initUIState UIInitOptions {..}
      ks <- initKeyHandlingState
  
      s <-
        loadScenarios
          (gsiScenarioInputs $ initState $ rs ^. stdGameConfigInputs)
          (loadTestScenarios $ mkRuntimeOptions opts)
      achievements <- loadAchievementsInfo
  
      let animState = AnimInactive
      let progState =
            ProgressionState
              { _scenarios = s
              , _attainedAchievements = M.fromList $ map (view achievement &&& id) achievements
              , _uiPopups = initPopupState
              , _scenarioSequence = mempty
              , _uiPopupAnimationState = animState
              }
      return $ PersistentState rs ui ks progState
    let initRS' = addWarnings initRS (F.toList warnings)
    return $ PersistentState initRS' initUI initKs initProg
  
  getScenarioInfoFromPath ::
    ScenarioCollection ScenarioInfo ->
    FilePath ->
    ScenarioInfo
  getScenarioInfoFromPath ss path =
    fromMaybe (ScenarioInfo path NotStarted) currentScenarioInfo
   where
    currentScenarioInfo = ss ^? scenarioItemByPath path . _SISingle . getScenarioInfo
  
  -- | Construct an 'AppState' from an already-loaded 'RuntimeState' and
  --   'UIState', given the 'AppOpts' the app was started with.
  constructAppState ::
    ( Has (Throw SystemFailure) sig m
    , Has (Lift IO) sig m
    ) =>
    PersistentState ->
    AppOpts ->
    Maybe (BChan AppEvent) ->
    m AppState
  constructAppState (PersistentState rs ui key progState) opts@(AppOpts {..}) mChan = do
    historyT <- sendIO $ readFileMayT =<< getSwarmHistoryPath False
    let mkREPLSubmission msg = REPLHistItem (REPLEntry Submitted) msg (TickNumber $ -1)
    let history = maybe [] (map mkREPLSubmission . T.lines) historyT
    startTime <- sendIO $ getTime Monotonic
    chan <- sendIO $ maybe initTestChan pure mChan
    animMgr <- sendIO $ startAnimationManager animMgrTickDuration chan PopupEvent
  
    let gsc = rs ^. stdGameConfigInputs
        gs = initGameState gsc
        ps =
          PlayState
            { _scenarioState = ScenarioState gs $ initialUiGameplay startTime history
            , _progression = progState
            }
  
    case skipMenu opts of
      False -> return $ AppState (ps & scenarioState . uiGameplay . uiTiming . lgTicksPerSecond .~ defaultInitLgTicksPerSecond) ui key rs animMgr
      True -> do
        let tem = gs ^. landscape . terrainAndEntities
        (scenario, path) <-
          loadScenario
            (fromMaybe "classic" userScenario)
            (ScenarioInputs (initWorldMap . gsiScenarioInputs . initState $ rs ^. stdGameConfigInputs) tem)
  
        codeToRun <- case runOpts of
          Just (RunScript s) -> Just <$> parseCodeFile s
          Just AutoPlay -> case scenario ^. scenarioOperation . scenarioSolution of
            Nothing -> throwError $ CustomFailure "No solution to autoplay"
            Just sol -> pure . Just $ CodeToRun ScenarioSuggested sol
          Just (Replay _) -> pure Nothing
          Nothing -> pure Nothing
  
        let replReplay = runOpts ^? _Just . _Replay
        appStateWithReplay <-
          execState
            (AppState ps ui key rs animMgr)
            (maybe (pure ()) startGameWithReplay replReplay)
  
        let si = getScenarioInfoFromPath (progState ^. scenarios) path
  
        sendIO $
          execStateT
            (startGameWithSeed (ScenarioWith scenario si) $ LaunchParams (pure userSeed) (pure codeToRun))
            appStateWithReplay
   where
    initialUiGameplay startTime history =
      UIGameplay
        { _uiFocusRing = initFocusRing
        , _uiWorldCursor = Nothing
        , _uiWorldEditor = initialWorldEditor startTime
        , _uiREPL = initREPLState Typing (newREPLHistory history)
        , _uiREPLReplay = mempty
        , _uiInventory =
            UIInventory
              { _uiInventoryList = Nothing
              , _uiInventorySort = defaultSortOptions
              , _uiInventorySearch = Nothing
              , _uiShowZero = True
              , _uiInventoryShouldUpdate = False
              }
        , _uiScrollToEnd = False
        , _uiDialogs =
            UIDialogs
              { _uiModal = Nothing
              , _uiGoal = emptyGoalDisplay
              , _uiStructure = emptyStructureDisplay
              , _uiRobot = emptyRobotDisplay debugOptions
              }
        , _uiIsAutoPlay = False
        , _uiAutoShowObjectives = autoShowObjectives
        , _uiTiming =
            UITiming
              { _uiShowFPS = False
              , _uiTPF = 0
              , _uiFPS = 0
              , _lgTicksPerSecond = speed
              , _lastFrameTime = startTime
              , _accumulatedTime = 0
              , _lastInfoTime = 0
              , _tickCount = 0
              , _frameCount = 0
              , _frameTickCount = 0
              }
        , _uiShowREPL = True
        , _uiShowDebug = False
        , _uiHideRobotsUntil = Nothing
        , _scenarioRef = Nothing
        }
  
  startGameWithReplay ::
    ( Has (Throw SystemFailure) sig m
    , Has (Lift IO) sig m
    , Has (State AppState) sig m
    ) =>
    FilePath ->
    m ()
  startGameWithReplay historySave = do
    runtimeState . eventLog EL.%= logEvent SystemLog Info "Replay" ("FILE: " <> T.pack (show historySave))
    sendIO (decodeFileEither historySave) >>= \case
      Left err -> throwError . CustomFailure . T.pack $ "Error parsing file: " <> prettyPrintParseException err
      Right repl -> do
        runtimeState . eventLog EL.%= logEvent SystemLog Info "Replay" ("PARSED: " <> T.pack (show repl))
        -- replControlMode is set based on this being not empty
        playState . scenarioState . uiGameplay . uiREPLReplay EL..= repl
        playState . scenarioState . uiGameplay . uiREPL . replControlMode EL..= Replaying
  
  -- | Load a 'Scenario' and start playing the game.
  startGame ::
    (MonadIO m, MonadState AppState m) =>
    NonEmpty (ScenarioWith ScenarioPath) ->
    Maybe CodeToRun ->
    m ()
  startGame (ScenarioWith s (ScenarioPath p) :| remaining) c = do
    playState . progression . scenarioSequence .= remaining
    ss <- use $ playState . progression . scenarios
    let si = getScenarioInfoFromPath ss p
    startGameWithSeed (ScenarioWith s si) . LaunchParams (pure Nothing) $ pure c
  
  -- | Re-initialize the game from the stored reference to the current scenario.
  --
  -- Note that "restarting" is intended only for "scenarios";
  -- with some scenarios, it may be possible to get stuck so that it is
  -- either impossible or very annoying to win, so being offered an
  -- option to restart is more user-friendly.
  --
  -- Since scenarios are stored as a Maybe in the UI state, we handle the Nothing
  -- case upstream so that the Scenario passed to this function definitely exists.
  restartGame ::
    (MonadIO m, MonadState AppState m) =>
    Seed ->
    ScenarioWith ScenarioPath ->
    m ()
  restartGame currentSeed (ScenarioWith s (ScenarioPath p)) = do
    ss <- use $ playState . progression . scenarios
    let si = getScenarioInfoFromPath ss p
    startGameWithSeed (ScenarioWith s si) $ LaunchParams (pure (Just currentSeed)) (pure Nothing)
  
  -- | Load a 'Scenario' and start playing the game, with the
  --   possibility for the user to override the seed.
  startGameWithSeed ::
    (MonadIO m, MonadState AppState m) =>
    ScenarioWith ScenarioInfo ->
    ValidatedLaunchParams ->
    m ()
  startGameWithSeed siPair@(ScenarioWith _scene si) lp = do
    t <- liftIO getZonedTime
    ss <- use $ playState . progression . scenarios
    p <- liftIO $ normalizeScenarioPath ss $ si ^. scenarioPath
  
    playState
      . progression
      . scenarios
      . scenarioItemByPath p
      . _SISingle
      . getScenarioInfo
      . scenarioStatus
      .= Played
        (toSerializableParams lp)
        (Metric Attempted $ ProgressStats t emptyAttemptMetric)
        (prevBest t)
  
    scenarioToAppState (pathifyCollection siPair) lp
  
    -- Warn the user that the use of debugging options means progress
    -- will not be saved.
    debugging <- use $ uiState . uiDebugOptions
    unless (null debugging) $
      playState . progression . uiPopups %= addPopup DebugWarningPopup
   where
    prevBest t = case si ^. scenarioStatus of
      NotStarted -> emptyBest t
      Played _ _ b -> b
  
  -- | Modify the 'AppState' appropriately when starting a new scenario.
  scenarioToAppState ::
    (MonadIO m, MonadState AppState m) =>
    ScenarioWith ScenarioPath ->
    ValidatedLaunchParams ->
    m ()
  scenarioToAppState siPair@(ScenarioWith scene p) lp = do
    rs <- use runtimeState
    prevGMetric <- use $ playState . scenarioState . gameState . gameMetrics
    prevWMetric <- use $ playState . scenarioState . gameState . landscape . worldMetrics
    gs <- liftIO $ scenarioToGameState (ScenarioWith scene $ Just p) lp prevGMetric prevWMetric rs
    playState . scenarioState . gameState .= gs
  
    curTime <- liftIO $ getTime Monotonic
    playState . scenarioState . uiGameplay %= setUIGameplay gs curTime isAutoplaying siPair
  
    void $ withLensIO uiState $ scenarioToUIState siPair
   where
    isAutoplaying = case fmap (view toRunSource) . runIdentity $ initialCode lp of
      Just ScenarioSuggested -> True
      _ -> False
  
    withLensIO :: (MonadIO m, MonadState AppState m) => Lens' AppState x -> (x -> IO x) -> m x
    withLensIO l a = do
      x <- use l
      x' <- liftIO $ a x
      l .= x'
      return x'
  
  setUIGameplay ::
    GameState ->
    TimeSpec ->
    Bool ->
    ScenarioWith ScenarioPath ->
    UIGameplay ->
    UIGameplay
  setUIGameplay gs curTime isAutoplaying siPair@(ScenarioWith scenario _) uig =
    uig
      & uiDialogs . uiGoal .~ emptyGoalDisplay
      & uiIsAutoPlay .~ isAutoplaying
      & uiFocusRing .~ initFocusRing
      & uiInventory . uiInventorySearch .~ Nothing
      & uiInventory . uiInventoryList .~ Nothing
      & uiInventory . uiInventorySort .~ defaultSortOptions
      & uiInventory . uiShowZero .~ True
      & uiTiming . uiShowFPS .~ False
      & uiREPL .~ initREPLState replMode (uig ^. uiREPL . replHistory)
      & uiREPL . replHistory %~ restartREPLHistory
      & scenarioRef ?~ siPair
      & uiTiming . lastFrameTime .~ curTime
      & uiWorldEditor . EM.entityPaintList %~ BL.listReplace entityList Nothing
      & uiWorldEditor . EM.editingBounds . EM.boundsRect %~ setNewBounds
      & uiDialogs . uiStructure
        .~ StructureDisplay
          (SR.makeListWidget . M.elems $ gs ^. landscape . recognizerAutomatons . originalStructureDefinitions)
          (focusSetCurrent (StructureWidgets StructuresList) $ focusRing $ map StructureWidgets enumerate)
   where
    replMode = if null $ uig ^. uiREPLReplay then Typing else Replaying
    entityList = EU.getEntitiesForList $ gs ^. landscape . terrainAndEntities . entityMap
  
    (isEmptyArea, newBounds) =
      EU.getEditingBounds $
        NE.head $
          scenario ^. scenarioLandscape . scenarioWorlds
  
    setNewBounds maybeOldBounds =
      if isEmptyArea
        then maybeOldBounds
        else Just newBounds
  
  -- | Modify the UI state appropriately when starting a new scenario.
  scenarioToUIState ::
    ScenarioWith a ->
    UIState ->
    IO UIState
  scenarioToUIState siPair u = do
    return $
      u
        & uiPlaying .~ True
        & uiAttrMap
          .~ applyAttrMappings
            ( map (first toAttrName . toAttrPair) $
                siPair ^. getScenario . scenarioLandscape . scenarioAttrs
            )
            swarmAttrMap
  
  -- | Create a BChan that holds only one event.
  --   This should only be used in unit tests, integration tests, and benchmarks
  initTestChan :: IO (BChan AppEvent)
  initTestChan = newBChan 1
  
  -- | Create an initial app state for a specific scenario.  Note that
  --   this function is used only for unit tests, integration tests, and
  --   benchmarks.
  --
  --   In normal play, an 'AppState' already exists and we simply need
  --   to update it using 'scenarioToAppState'.
  initAppStateForScenario :: String -> Maybe Seed -> Maybe FilePath -> ExceptT Text IO AppState
  initAppStateForScenario sceneName userSeed toRun =
    asExceptT . withThrow (prettyText @SystemFailure) . flip initAppState Nothing $
      defaultAppOpts
        { userScenario = Just sceneName
        , userSeed = userSeed
        , runOpts = RunScript <$> toRun
        }
  
  -- | For convenience, the 'AppState' corresponding to the classic game
  --   with seed 0.  This is used only for benchmarks and unit tests.
  classicGame0 :: ExceptT Text IO AppState
  classicGame0 = initAppStateForScenario "classic" (Just 0) Nothing
  