-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Collection of functions used to save the scenario metadata.
module Swarm.TUI.Controller.SaveScenario (
  saveScenarioInfoOnFinish,
  saveScenarioInfoOnFinishNocheat,
  saveScenarioInfoOnQuit,
) where

-- See Note [liftA2 re-export from Prelude]

import Brick
import Control.Lens as Lens
import Control.Monad (forM_, unless, when)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Maybe (listToMaybe)
import Data.Set (Set)
import Data.Time (ZonedTime, getZonedTime)
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Scenario.Status
import Swarm.Game.ScenarioInfo
import Swarm.Game.State
import Swarm.Game.State.Substate
import Swarm.TUI.Model
import Swarm.TUI.Model.Achievements (attainAchievement, attainAchievement')
import Swarm.TUI.Model.DebugOption (DebugOption)
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI.Gameplay
import System.FilePath (splitDirectories)

getNormalizedCurrentScenarioPath ::
  MonadIO m =>
  GameState ->
  ScenarioCollection a ->
  m (Maybe FilePath)
getNormalizedCurrentScenarioPath :: forall (m :: * -> *) a.
MonadIO m =>
GameState -> ScenarioCollection a -> m (Maybe FilePath)
getNormalizedCurrentScenarioPath GameState
gs ScenarioCollection a
sc = do
  -- the path should be normalized and good to search in scenario collection
  (ScenarioPath -> m FilePath)
-> Maybe ScenarioPath -> m (Maybe FilePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (ScenarioPath -> IO FilePath) -> ScenarioPath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection a -> FilePath -> IO FilePath
forall (m :: * -> *) a.
MonadIO m =>
ScenarioCollection a -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection a
sc (FilePath -> IO FilePath)
-> (ScenarioPath -> FilePath) -> ScenarioPath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioPath -> FilePath
getScenarioPath) (Maybe ScenarioPath -> m (Maybe FilePath))
-> Maybe ScenarioPath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState
-> Getting (Maybe ScenarioPath) GameState (Maybe ScenarioPath)
-> Maybe ScenarioPath
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ScenarioPath) GameState (Maybe ScenarioPath)
Lens' GameState (Maybe ScenarioPath)
currentScenarioPath

applyCompletionAchievements ::
  Bool ->
  ZonedTime ->
  FilePath ->
  EventM n ProgressionState ()
applyCompletionAchievements :: forall n.
Bool -> ZonedTime -> FilePath -> EventM n ProgressionState ()
applyCompletionAchievements Bool
won ZonedTime
t FilePath
p = do
  Maybe FilePath
-> (FilePath -> EventM n ProgressionState ())
-> EventM n ProgressionState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
listToMaybe ([FilePath] -> Maybe FilePath) -> [FilePath] -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
p) ((FilePath -> EventM n ProgressionState ())
 -> EventM n ProgressionState ())
-> (FilePath -> EventM n ProgressionState ())
-> EventM n ProgressionState ()
forall a b. (a -> b) -> a -> b
$ \FilePath
firstDir -> do
    Bool
-> EventM n ProgressionState () -> EventM n ProgressionState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
won Bool -> Bool -> Bool
&& FilePath
firstDir FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
tutorialsDirname) (EventM n ProgressionState () -> EventM n ProgressionState ())
-> EventM n ProgressionState () -> EventM n ProgressionState ()
forall a b. (a -> b) -> a -> b
$
      ZonedTime
-> Maybe ScenarioPath
-> CategorizedAchievement
-> EventM n ProgressionState ()
forall n.
ZonedTime
-> Maybe ScenarioPath
-> CategorizedAchievement
-> EventM n ProgressionState ()
attainAchievement' ZonedTime
t (ScenarioPath -> Maybe ScenarioPath
forall a. a -> Maybe a
Just (ScenarioPath -> Maybe ScenarioPath)
-> ScenarioPath -> Maybe ScenarioPath
forall a b. (a -> b) -> a -> b
$ FilePath -> ScenarioPath
ScenarioPath FilePath
p) (CategorizedAchievement -> EventM n ProgressionState ())
-> CategorizedAchievement -> EventM n ProgressionState ()
forall a b. (a -> b) -> a -> b
$
        GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
CompletedSingleTutorial

  -- Check if all tutorials have been completed
  OMap FilePath (ScenarioItem ScenarioInfo)
tutorialMap <- Getting
  (OMap FilePath (ScenarioItem ScenarioInfo))
  ProgressionState
  (OMap FilePath (ScenarioItem ScenarioInfo))
-> EventM
     n ProgressionState (OMap FilePath (ScenarioItem ScenarioInfo))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (OMap FilePath (ScenarioItem ScenarioInfo))
   ProgressionState
   (OMap FilePath (ScenarioItem ScenarioInfo))
 -> EventM
      n ProgressionState (OMap FilePath (ScenarioItem ScenarioInfo)))
-> Getting
     (OMap FilePath (ScenarioItem ScenarioInfo))
     ProgressionState
     (OMap FilePath (ScenarioItem ScenarioInfo))
-> EventM
     n ProgressionState (OMap FilePath (ScenarioItem ScenarioInfo))
forall a b. (a -> b) -> a -> b
$ (ScenarioCollection ScenarioInfo
 -> Const
      (OMap FilePath (ScenarioItem ScenarioInfo))
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const
     (OMap FilePath (ScenarioItem ScenarioInfo)) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios ((ScenarioCollection ScenarioInfo
  -> Const
       (OMap FilePath (ScenarioItem ScenarioInfo))
       (ScenarioCollection ScenarioInfo))
 -> ProgressionState
 -> Const
      (OMap FilePath (ScenarioItem ScenarioInfo)) ProgressionState)
-> ((OMap FilePath (ScenarioItem ScenarioInfo)
     -> Const
          (OMap FilePath (ScenarioItem ScenarioInfo))
          (OMap FilePath (ScenarioItem ScenarioInfo)))
    -> ScenarioCollection ScenarioInfo
    -> Const
         (OMap FilePath (ScenarioItem ScenarioInfo))
         (ScenarioCollection ScenarioInfo))
-> Getting
     (OMap FilePath (ScenarioItem ScenarioInfo))
     ProgressionState
     (OMap FilePath (ScenarioItem ScenarioInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> ScenarioCollection ScenarioInfo)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (OMap FilePath (ScenarioItem ScenarioInfo))
         (ScenarioCollection ScenarioInfo))
-> ScenarioCollection ScenarioInfo
-> Const
     (OMap FilePath (ScenarioItem ScenarioInfo))
     (ScenarioCollection ScenarioInfo)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ScenarioCollection ScenarioInfo -> ScenarioCollection ScenarioInfo
forall a. ScenarioCollection a -> ScenarioCollection a
getTutorials ((ScenarioCollection ScenarioInfo
  -> Const
       (OMap FilePath (ScenarioItem ScenarioInfo))
       (ScenarioCollection ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> Const
      (OMap FilePath (ScenarioItem ScenarioInfo))
      (ScenarioCollection ScenarioInfo))
-> ((OMap FilePath (ScenarioItem ScenarioInfo)
     -> Const
          (OMap FilePath (ScenarioItem ScenarioInfo))
          (OMap FilePath (ScenarioItem ScenarioInfo)))
    -> ScenarioCollection ScenarioInfo
    -> Const
         (OMap FilePath (ScenarioItem ScenarioInfo))
         (ScenarioCollection ScenarioInfo))
-> (OMap FilePath (ScenarioItem ScenarioInfo)
    -> Const
         (OMap FilePath (ScenarioItem ScenarioInfo))
         (OMap FilePath (ScenarioItem ScenarioInfo)))
-> ScenarioCollection ScenarioInfo
-> Const
     (OMap FilePath (ScenarioItem ScenarioInfo))
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> OMap FilePath (ScenarioItem ScenarioInfo))
-> (OMap FilePath (ScenarioItem ScenarioInfo)
    -> Const
         (OMap FilePath (ScenarioItem ScenarioInfo))
         (OMap FilePath (ScenarioItem ScenarioInfo)))
-> ScenarioCollection ScenarioInfo
-> Const
     (OMap FilePath (ScenarioItem ScenarioInfo))
     (ScenarioCollection ScenarioInfo)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ScenarioCollection ScenarioInfo
-> OMap FilePath (ScenarioItem ScenarioInfo)
forall a. ScenarioCollection a -> OMap FilePath (ScenarioItem a)
scMap
  let isComplete :: ScenarioItem ScenarioInfo -> Bool
isComplete (SISingle (ScenarioWith Scenario
_ ScenarioInfo
s)) = ScenarioInfo -> Bool
scenarioIsCompleted ScenarioInfo
s
      -- There are not currently any subcollections within the
      -- tutorials, but checking subcollections recursively just seems
      -- like the right thing to do
      isComplete (SICollection Text
_ (SC OMap FilePath (ScenarioItem ScenarioInfo)
m)) = (ScenarioItem ScenarioInfo -> Bool)
-> OMap FilePath (ScenarioItem ScenarioInfo) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ScenarioItem ScenarioInfo -> Bool
isComplete OMap FilePath (ScenarioItem ScenarioInfo)
m

  Bool
-> EventM n ProgressionState () -> EventM n ProgressionState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((ScenarioItem ScenarioInfo -> Bool)
-> OMap FilePath (ScenarioItem ScenarioInfo) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ScenarioItem ScenarioInfo -> Bool
isComplete OMap FilePath (ScenarioItem ScenarioInfo)
tutorialMap) (EventM n ProgressionState () -> EventM n ProgressionState ())
-> EventM n ProgressionState () -> EventM n ProgressionState ()
forall a b. (a -> b) -> a -> b
$
    CategorizedAchievement -> EventM n ProgressionState ()
forall n. CategorizedAchievement -> EventM n ProgressionState ()
attainAchievement (CategorizedAchievement -> EventM n ProgressionState ())
-> CategorizedAchievement -> EventM n ProgressionState ()
forall a b. (a -> b) -> a -> b
$
      GlobalAchievement -> CategorizedAchievement
GlobalAchievement GlobalAchievement
CompletedAllTutorials

saveScenarioInfoOnFinish ::
  FilePath ->
  EventM n PlayState ()
saveScenarioInfoOnFinish :: forall n. FilePath -> EventM n PlayState ()
saveScenarioInfoOnFinish FilePath
p = do
  Maybe Syntax
initialRunCode <- Getting (Maybe Syntax) PlayState (Maybe Syntax)
-> EventM n PlayState (Maybe Syntax)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe Syntax) PlayState (Maybe Syntax)
 -> EventM n PlayState (Maybe Syntax))
-> Getting (Maybe Syntax) PlayState (Maybe Syntax)
-> EventM n PlayState (Maybe Syntax)
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const (Maybe Syntax) ScenarioState)
-> PlayState -> Const (Maybe Syntax) PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const (Maybe Syntax) ScenarioState)
 -> PlayState -> Const (Maybe Syntax) PlayState)
-> ((Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
    -> ScenarioState -> Const (Maybe Syntax) ScenarioState)
-> Getting (Maybe Syntax) PlayState (Maybe Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const (Maybe Syntax) GameState)
-> ScenarioState -> Const (Maybe Syntax) ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const (Maybe Syntax) GameState)
 -> ScenarioState -> Const (Maybe Syntax) ScenarioState)
-> ((Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
    -> GameState -> Const (Maybe Syntax) GameState)
-> (Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
-> ScenarioState
-> Const (Maybe Syntax) ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameControls -> Const (Maybe Syntax) GameControls)
-> GameState -> Const (Maybe Syntax) GameState
Lens' GameState GameControls
gameControls ((GameControls -> Const (Maybe Syntax) GameControls)
 -> GameState -> Const (Maybe Syntax) GameState)
-> ((Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
    -> GameControls -> Const (Maybe Syntax) GameControls)
-> (Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
-> GameState
-> Const (Maybe Syntax) GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Syntax -> Const (Maybe Syntax) (Maybe Syntax))
-> GameControls -> Const (Maybe Syntax) GameControls
Lens' GameControls (Maybe Syntax)
initiallyRunCode
  ZonedTime
t <- IO ZonedTime -> EventM n PlayState ZonedTime
forall a. IO a -> EventM n PlayState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  WinCondition
wc <- Getting WinCondition PlayState WinCondition
-> EventM n PlayState WinCondition
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting WinCondition PlayState WinCondition
 -> EventM n PlayState WinCondition)
-> Getting WinCondition PlayState WinCondition
-> EventM n PlayState WinCondition
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const WinCondition ScenarioState)
-> PlayState -> Const WinCondition PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const WinCondition ScenarioState)
 -> PlayState -> Const WinCondition PlayState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> ScenarioState -> Const WinCondition ScenarioState)
-> Getting WinCondition PlayState WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const WinCondition GameState)
-> ScenarioState -> Const WinCondition ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const WinCondition GameState)
 -> ScenarioState -> Const WinCondition ScenarioState)
-> ((WinCondition -> Const WinCondition WinCondition)
    -> GameState -> Const WinCondition GameState)
-> (WinCondition -> Const WinCondition WinCondition)
-> ScenarioState
-> Const WinCondition ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WinCondition -> Const WinCondition WinCondition)
-> GameState -> Const WinCondition GameState
Lens' GameState WinCondition
winCondition
  let won :: Bool
won = case WinCondition
wc of
        WinConditions (Won Bool
_ TickNumber
_) ObjectiveCompletion
_ -> Bool
True
        WinCondition
_ -> Bool
False
  TickNumber
ts <- Getting TickNumber PlayState TickNumber
-> EventM n PlayState TickNumber
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting TickNumber PlayState TickNumber
 -> EventM n PlayState TickNumber)
-> Getting TickNumber PlayState TickNumber
-> EventM n PlayState TickNumber
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const TickNumber ScenarioState)
-> PlayState -> Const TickNumber PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const TickNumber ScenarioState)
 -> PlayState -> Const TickNumber PlayState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> ScenarioState -> Const TickNumber ScenarioState)
-> Getting TickNumber PlayState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const TickNumber GameState)
-> ScenarioState -> Const TickNumber ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const TickNumber GameState)
 -> ScenarioState -> Const TickNumber ScenarioState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> GameState -> Const TickNumber GameState)
-> (TickNumber -> Const TickNumber TickNumber)
-> ScenarioState
-> Const TickNumber ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TemporalState -> Const TickNumber TemporalState)
-> GameState -> Const TickNumber GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Const TickNumber TemporalState)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> TemporalState -> Const TickNumber TemporalState)
-> (TickNumber -> Const TickNumber TickNumber)
-> GameState
-> Const TickNumber GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> TemporalState -> Const TickNumber TemporalState
Lens' TemporalState TickNumber
ticks
  Bool
saved <- Getting Bool PlayState Bool -> EventM n PlayState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool PlayState Bool -> EventM n PlayState Bool)
-> Getting Bool PlayState Bool -> EventM n PlayState Bool
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const Bool ScenarioState)
-> PlayState -> Const Bool PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Bool ScenarioState)
 -> PlayState -> Const Bool PlayState)
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> Getting Bool PlayState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const Bool GameState)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Const Bool GameState)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool) -> GameState -> Const Bool GameState)
-> (Bool -> Const Bool Bool)
-> ScenarioState
-> Const Bool ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> GameState -> Const Bool GameState
Lens' GameState Bool
completionStatsSaved

  let currentScenarioInfo :: Traversal' PlayState ScenarioInfo
      currentScenarioInfo :: Traversal' PlayState ScenarioInfo
currentScenarioInfo = (ProgressionState -> f ProgressionState)
-> PlayState -> f PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> f ProgressionState)
 -> PlayState -> f PlayState)
-> ((ScenarioInfo -> f ScenarioInfo)
    -> ProgressionState -> f ProgressionState)
-> (ScenarioInfo -> f ScenarioInfo)
-> PlayState
-> f PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> f (ScenarioCollection ScenarioInfo))
-> ProgressionState -> f ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios ((ScenarioCollection ScenarioInfo
  -> f (ScenarioCollection ScenarioInfo))
 -> ProgressionState -> f ProgressionState)
-> ((ScenarioInfo -> f ScenarioInfo)
    -> ScenarioCollection ScenarioInfo
    -> f (ScenarioCollection ScenarioInfo))
-> (ScenarioInfo -> f ScenarioInfo)
-> ProgressionState
-> f ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Traversal'
     (ScenarioCollection ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a.
FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath FilePath
p ((ScenarioItem ScenarioInfo -> f (ScenarioItem ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> f (ScenarioCollection ScenarioInfo))
-> ((ScenarioInfo -> f ScenarioInfo)
    -> ScenarioItem ScenarioInfo -> f (ScenarioItem ScenarioInfo))
-> (ScenarioInfo -> f ScenarioInfo)
-> ScenarioCollection ScenarioInfo
-> f (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioWith ScenarioInfo -> f (ScenarioWith ScenarioInfo))
-> ScenarioItem ScenarioInfo -> f (ScenarioItem ScenarioInfo)
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ScenarioWith a) (f (ScenarioWith a))
-> p (ScenarioItem a) (f (ScenarioItem a))
_SISingle ((ScenarioWith ScenarioInfo -> f (ScenarioWith ScenarioInfo))
 -> ScenarioItem ScenarioInfo -> f (ScenarioItem ScenarioInfo))
-> ((ScenarioInfo -> f ScenarioInfo)
    -> ScenarioWith ScenarioInfo -> f (ScenarioWith ScenarioInfo))
-> (ScenarioInfo -> f ScenarioInfo)
-> ScenarioItem ScenarioInfo
-> f (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> f ScenarioInfo)
-> ScenarioWith ScenarioInfo -> f (ScenarioWith ScenarioInfo)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ScenarioWith a1 -> f (ScenarioWith a2)
getScenarioInfo

  REPLHistory
replHist <- Getting REPLHistory PlayState REPLHistory
-> EventM n PlayState REPLHistory
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting REPLHistory PlayState REPLHistory
 -> EventM n PlayState REPLHistory)
-> Getting REPLHistory PlayState REPLHistory
-> EventM n PlayState REPLHistory
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const REPLHistory ScenarioState)
-> PlayState -> Const REPLHistory PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const REPLHistory ScenarioState)
 -> PlayState -> Const REPLHistory PlayState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> ScenarioState -> Const REPLHistory ScenarioState)
-> Getting REPLHistory PlayState REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const REPLHistory UIGameplay)
-> ScenarioState -> Const REPLHistory ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const REPLHistory UIGameplay)
 -> ScenarioState -> Const REPLHistory ScenarioState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIGameplay -> Const REPLHistory UIGameplay)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> ScenarioState
-> Const REPLHistory ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Const REPLHistory REPLState)
-> UIGameplay -> Const REPLHistory UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLHistory REPLState)
 -> UIGameplay -> Const REPLHistory UIGameplay)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIGameplay
-> Const REPLHistory UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory
  let determinator :: CodeSizeDeterminators
determinator = Maybe Syntax -> Bool -> CodeSizeDeterminators
CodeSizeDeterminators Maybe Syntax
initialRunCode (Bool -> CodeSizeDeterminators) -> Bool -> CodeSizeDeterminators
forall a b. (a -> b) -> a -> b
$ REPLHistory
replHist REPLHistory -> Getting Bool REPLHistory Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool REPLHistory Bool
Lens' REPLHistory Bool
replHasExecutedManualInput

  -- Don't update scenario statistics if we have previously saved
  -- statistics for the current scenario upon scenario completion.
  Bool -> EventM n PlayState () -> EventM n PlayState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
saved (EventM n PlayState () -> EventM n PlayState ())
-> EventM n PlayState () -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$
    (ScenarioInfo -> Identity ScenarioInfo)
-> PlayState -> Identity PlayState
Traversal' PlayState ScenarioInfo
currentScenarioInfo
      ((ScenarioInfo -> Identity ScenarioInfo)
 -> PlayState -> Identity PlayState)
-> (ScenarioInfo -> ScenarioInfo) -> EventM n PlayState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= CodeSizeDeterminators
-> ZonedTime -> TickNumber -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnFinish CodeSizeDeterminators
determinator ZonedTime
t TickNumber
ts Bool
won

  Maybe ScenarioInfo
status <- Getting (First ScenarioInfo) PlayState ScenarioInfo
-> EventM n PlayState (Maybe ScenarioInfo)
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse Getting (First ScenarioInfo) PlayState ScenarioInfo
Traversal' PlayState ScenarioInfo
currentScenarioInfo
  Maybe ScenarioInfo
-> (ScenarioInfo -> EventM n PlayState ()) -> EventM n PlayState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ScenarioInfo
status ((ScenarioInfo -> EventM n PlayState ()) -> EventM n PlayState ())
-> (ScenarioInfo -> EventM n PlayState ()) -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$ \ScenarioInfo
si -> do
    IO () -> EventM n PlayState ()
forall a. IO a -> EventM n PlayState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> EventM n PlayState ()) -> IO () -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ScenarioInfo -> IO ()
saveScenarioInfo FilePath
p ScenarioInfo
si
    LensLike'
  (Zoomed (EventM n ProgressionState) ()) PlayState ProgressionState
-> EventM n ProgressionState () -> EventM n PlayState ()
forall c.
LensLike'
  (Zoomed (EventM n ProgressionState) c) PlayState ProgressionState
-> EventM n ProgressionState c -> EventM n PlayState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom (ProgressionState
 -> Focusing (StateT (EventState n) IO) () ProgressionState)
-> PlayState -> Focusing (StateT (EventState n) IO) () PlayState
LensLike'
  (Zoomed (EventM n ProgressionState) ()) PlayState ProgressionState
Lens' PlayState ProgressionState
progression (EventM n ProgressionState () -> EventM n PlayState ())
-> EventM n ProgressionState () -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$ Bool -> ZonedTime -> FilePath -> EventM n ProgressionState ()
forall n.
Bool -> ZonedTime -> FilePath -> EventM n ProgressionState ()
applyCompletionAchievements Bool
won ZonedTime
t FilePath
p

  (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((Bool -> Identity Bool)
    -> ScenarioState -> Identity ScenarioState)
-> (Bool -> Identity Bool)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> ScenarioState -> Identity ScenarioState)
-> ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> (Bool -> Identity Bool)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
completionStatsSaved ((Bool -> Identity Bool) -> PlayState -> Identity PlayState)
-> Bool -> EventM n PlayState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
won

-- | Don't save progress for developers or cheaters.
unlessCheating :: Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
unlessCheating :: forall n.
Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
unlessCheating Set DebugOption
dOpts EventM n PlayState ()
a = do
  Bool
isAuto <- Getting Bool PlayState Bool -> EventM n PlayState Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting Bool PlayState Bool -> EventM n PlayState Bool)
-> Getting Bool PlayState Bool -> EventM n PlayState Bool
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const Bool ScenarioState)
-> PlayState -> Const Bool PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const Bool ScenarioState)
 -> PlayState -> Const Bool PlayState)
-> ((Bool -> Const Bool Bool)
    -> ScenarioState -> Const Bool ScenarioState)
-> Getting Bool PlayState Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const Bool UIGameplay)
-> ScenarioState -> Const Bool ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Const Bool UIGameplay)
 -> ScenarioState -> Const Bool ScenarioState)
-> ((Bool -> Const Bool Bool)
    -> UIGameplay -> Const Bool UIGameplay)
-> (Bool -> Const Bool Bool)
-> ScenarioState
-> Const Bool ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> UIGameplay -> Const Bool UIGameplay
Lens' UIGameplay Bool
uiIsAutoPlay
  Bool -> EventM n PlayState () -> EventM n PlayState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set DebugOption -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set DebugOption
dOpts Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isAuto) EventM n PlayState ()
a

-- | Write the @ScenarioInfo@ out to disk when finishing a game (i.e. on winning or exit).
saveScenarioInfoOnFinishNocheat :: Set DebugOption -> EventM n PlayState ()
saveScenarioInfoOnFinishNocheat :: forall n. Set DebugOption -> EventM n PlayState ()
saveScenarioInfoOnFinishNocheat Set DebugOption
dOpts = do
  ScenarioCollection ScenarioInfo
sc <- Getting
  (ScenarioCollection ScenarioInfo)
  PlayState
  (ScenarioCollection ScenarioInfo)
-> EventM n PlayState (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   PlayState
   (ScenarioCollection ScenarioInfo)
 -> EventM n PlayState (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     PlayState
     (ScenarioCollection ScenarioInfo)
-> EventM n PlayState (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> ProgressionState
    -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     PlayState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const
      (ScenarioCollection ScenarioInfo)
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const (ScenarioCollection ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
  GameState
gs <- Getting GameState PlayState GameState
-> EventM n PlayState GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GameState PlayState GameState
 -> EventM n PlayState GameState)
-> Getting GameState PlayState GameState
-> EventM n PlayState GameState
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const GameState ScenarioState)
-> PlayState -> Const GameState PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const GameState ScenarioState)
 -> PlayState -> Const GameState PlayState)
-> ((GameState -> Const GameState GameState)
    -> ScenarioState -> Const GameState ScenarioState)
-> Getting GameState PlayState GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const GameState GameState)
-> ScenarioState -> Const GameState ScenarioState
Lens' ScenarioState GameState
gameState
  Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
forall n.
Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
unlessCheating Set DebugOption
dOpts (EventM n PlayState () -> EventM n PlayState ())
-> EventM n PlayState () -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$
    -- the path should be normalized and good to search in scenario collection
    GameState
-> ScenarioCollection ScenarioInfo
-> EventM n PlayState (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
GameState -> ScenarioCollection a -> m (Maybe FilePath)
getNormalizedCurrentScenarioPath GameState
gs ScenarioCollection ScenarioInfo
sc EventM n PlayState (Maybe FilePath)
-> (Maybe FilePath -> EventM n PlayState ())
-> EventM n PlayState ()
forall a b.
EventM n PlayState a
-> (a -> EventM n PlayState b) -> EventM n PlayState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> EventM n PlayState ())
-> Maybe FilePath -> EventM n PlayState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> EventM n PlayState ()
forall n. FilePath -> EventM n PlayState ()
saveScenarioInfoOnFinish

-- | Write the @ScenarioInfo@ out to disk when exiting a game.
saveScenarioInfoOnQuit :: Set DebugOption -> EventM n PlayState ()
saveScenarioInfoOnQuit :: forall n. Set DebugOption -> EventM n PlayState ()
saveScenarioInfoOnQuit Set DebugOption
dOpts = do
  ScenarioCollection ScenarioInfo
sc <- Getting
  (ScenarioCollection ScenarioInfo)
  PlayState
  (ScenarioCollection ScenarioInfo)
-> EventM n PlayState (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   PlayState
   (ScenarioCollection ScenarioInfo)
 -> EventM n PlayState (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     PlayState
     (ScenarioCollection ScenarioInfo)
-> EventM n PlayState (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> ProgressionState
    -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     PlayState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Const
      (ScenarioCollection ScenarioInfo)
      (ScenarioCollection ScenarioInfo))
-> ProgressionState
-> Const (ScenarioCollection ScenarioInfo) ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
  GameState
gs <- Getting GameState PlayState GameState
-> EventM n PlayState GameState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting GameState PlayState GameState
 -> EventM n PlayState GameState)
-> Getting GameState PlayState GameState
-> EventM n PlayState GameState
forall a b. (a -> b) -> a -> b
$ (ScenarioState -> Const GameState ScenarioState)
-> PlayState -> Const GameState PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Const GameState ScenarioState)
 -> PlayState -> Const GameState PlayState)
-> ((GameState -> Const GameState GameState)
    -> ScenarioState -> Const GameState ScenarioState)
-> Getting GameState PlayState GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Const GameState GameState)
-> ScenarioState -> Const GameState ScenarioState
Lens' ScenarioState GameState
gameState
  Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
forall n.
Set DebugOption -> EventM n PlayState () -> EventM n PlayState ()
unlessCheating Set DebugOption
dOpts (EventM n PlayState () -> EventM n PlayState ())
-> EventM n PlayState () -> EventM n PlayState ()
forall a b. (a -> b) -> a -> b
$
    GameState
-> ScenarioCollection ScenarioInfo
-> EventM n PlayState (Maybe FilePath)
forall (m :: * -> *) a.
MonadIO m =>
GameState -> ScenarioCollection a -> m (Maybe FilePath)
getNormalizedCurrentScenarioPath GameState
gs ScenarioCollection ScenarioInfo
sc EventM n PlayState (Maybe FilePath)
-> (Maybe FilePath -> EventM n PlayState ())
-> EventM n PlayState ()
forall a b.
EventM n PlayState a
-> (a -> EventM n PlayState b) -> EventM n PlayState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> EventM n PlayState ())
-> Maybe FilePath -> EventM n PlayState ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> EventM n PlayState ()
forall n. FilePath -> EventM n PlayState ()
saveScenarioInfoOnFinish