Don't run initEvent when loading the game

Rather than having a single sentWelcome boolean, avoid running the
initEvent entirely when loading an already-initialized game. Among other
things, this stops us from re-generating a level and then merging it
with the existing one when the game is loaded (oops).

5 files changed, 17 insertions, 18 deletions

diff --git a/src/Main.hs b/src/Main.hs
index b11f1b9f4960..95cfc9edbaff 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -9,7 +9,7 @@ import           Control.Exception (finally)
 import           System.Exit (die)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Game as Game
-import           Xanthous.App (makeApp)
+import           Xanthous.App
 import           Xanthous.Generators
                  ( GeneratorInput
                  , parseGeneratorInput
@@ -94,7 +94,7 @@ thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!"
 
 runGame :: RunParams -> IO ()
 runGame rparams = do
-  app <- makeApp
+  app <- makeApp NewGame
   gameSeed <- maybe getRandom pure $ seed rparams
   when (isNothing $ seed rparams)
     . putStrLn
@@ -113,7 +113,7 @@ runGame rparams = do
 
 loadGame :: FilePath -> IO ()
 loadGame saveFile = do
-  app <- makeApp
+  app <- makeApp LoadGame
   gameState <- maybe (die "Invalid save file!") pure
               =<< Game.loadGame . fromStrict <$> readFile @IO saveFile
   _game' <- gameState `deepseq` defaultMain app gameState `finally` thanks
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index ab7c8f8e5049..24073c51097a 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -2,7 +2,10 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE RecordWildCards      #-}
 --------------------------------------------------------------------------------
-module Xanthous.App (makeApp) where
+module Xanthous.App
+  ( makeApp
+  , RunType(..)
+  ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
 import           Brick hiding (App, halt, continue, raw)
@@ -66,12 +69,17 @@ import qualified Xanthous.Generators.Dungeon as Dungeon
 
 type App = Brick.App GameState () Name
 
-makeApp :: IO App
-makeApp = pure $ Brick.App
+data RunType = NewGame | LoadGame
+  deriving stock (Eq)
+
+makeApp :: RunType -> IO App
+makeApp rt = pure $ Brick.App
   { appDraw = drawGame
   , appChooseCursor = const headMay
   , appHandleEvent = \game event -> runAppM (handleEvent event) game
-  , appStartEvent = runAppM $ startEvent >> get
+  , appStartEvent = case rt of
+      NewGame -> runAppM $ startEvent >> get
+      LoadGame -> pure
   , appAttrMap = const $ attrMap defAttr []
   }
 
@@ -86,12 +94,8 @@ startEvent = do
     Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
       $ \(StringResult s) -> do
         character . characterName ?= s
-        whenM (uses sentWelcome not) $ say ["welcome"] =<< use character
-        sentWelcome .= True
-    Just n ->
-      whenM (uses sentWelcome not) $ do
-        say ["welcome"] $ object [ "characterName" A..= n ]
-        sentWelcome .= True
+        say ["welcome"] =<< use character
+    Just n -> say ["welcome"] $ object [ "characterName" A..= n ]
 
 initLevel :: AppM ()
 initLevel = do
diff --git a/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs
index 4a64a12be096..886a8c03d786 100644
--- a/src/Xanthous/Game/Arbitrary.hs
+++ b/src/Xanthous/Game/Arbitrary.hs
@@ -40,7 +40,6 @@ instance Arbitrary GameState where
     let _promptState = NoPrompt -- TODO
     _activePanel <- arbitrary
     _debugState <- arbitrary
-    _sentWelcome <- arbitrary
     pure $ GameState {..}
 
 
diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs
index dc886f65c698..017d53652c4f 100644
--- a/src/Xanthous/Game/Lenses.hs
+++ b/src/Xanthous/Game/Lenses.hs
@@ -56,7 +56,6 @@ initialStateFromSeed seed =
       _debugState = DebugState
         { _allRevealed = False
         }
-      _sentWelcome = False
   in GameState {..}
 
 
diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 100204c755c3..80137df7a721 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -12,7 +12,6 @@ module Xanthous.Game.State
   , messageHistory
   , randomGen
   , activePanel
-  , sentWelcome
   , promptState
   , characterEntityID
   , GamePromptState(..)
@@ -434,7 +433,6 @@ data GameState = GameState
   , _characterEntityID :: !EntityID
   , _messageHistory    :: !MessageHistory
   , _randomGen         :: !StdGen
-  , _sentWelcome       :: Bool
 
     -- | The active panel displayed in the UI, if any
   , _activePanel       :: !(Maybe Panel)
@@ -463,7 +461,6 @@ instance Eq GameState where
     , gs ^. revealedPositions
     , gs ^. characterEntityID
     , gs ^. messageHistory
-    , gs ^. sentWelcome
     , gs ^. activePanel
     , gs ^. debugState
     )