feat(gs/xanthous): Allow disabling saving r/3017

Add a command-line parameter to disable the Save command, so people
don't save and fill up my disk when I'm running this on the internet.

Change-Id: I2408e60de2d99764ac53c21c3ea784282576d400
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3808
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

1 files changed, 19 insertions, 7 deletions

diff --git a/users/grfn/xanthous/app/Main.hs b/users/grfn/xanthous/app/Main.hs
index e67ad4ac99..c771a0d932 100644
--- a/users/grfn/xanthous/app/Main.hs
+++ b/users/grfn/xanthous/app/Main.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
 module Main ( main ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding (finally)
@@ -12,6 +14,7 @@ import           System.Exit (die)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Game as Game
 import           Xanthous.Game.Env (GameEnv(..))
+import qualified Xanthous.Game.Env as Game
 import           Xanthous.App
 import           Xanthous.Generators.Level
                  ( GeneratorInput
@@ -26,9 +29,17 @@ import           Xanthous.Data (Dimensions, Dimensions'(Dimensions))
 import           Data.Array.IArray ( amap )
 --------------------------------------------------------------------------------
 
+parseGameConfig :: Opt.Parser Game.Config
+parseGameConfig = Game.Config
+  <$> Opt.switch
+      ( Opt.long "disable-saving"
+      <> Opt.help "Disallow saving games"
+      )
+
 data RunParams = RunParams
   { seed :: Maybe Int
   , characterName :: Maybe Text
+  , gameConfig :: Game.Config
   }
   deriving stock (Show, Eq)
 
@@ -46,6 +57,7 @@ parseRunParams = RunParams
         <> "will be prompted for at runtime"
         )
       ))
+  <*> parseGameConfig
 
 data Command
   = Run RunParams
@@ -104,7 +116,7 @@ newGame rparams = do
   let initialState = Game.initialStateFromSeed gameSeed &~ do
         for_ (characterName rparams) $ \cn ->
           Game.character . Character.characterName ?= cn
-  runGame NewGame initialState `finally` do
+  runGame NewGame (gameConfig rparams) initialState `finally` do
     thanks
     when (isNothing $ seed rparams)
       . putStrLn
@@ -115,19 +127,19 @@ loadGame :: FilePath -> IO ()
 loadGame saveFile = do
   gameState <- maybe (die "Invalid save file!") pure . Game.loadGame  . fromStrict
               =<< readFile @IO saveFile
-  gameState `deepseq` runGame (LoadGame saveFile) gameState
+  gameState `deepseq` runGame (LoadGame saveFile) Game.defaultConfig gameState
 
-runGame :: RunType -> Game.GameState -> IO ()
-runGame rt gameState = do
-  eventChan <- Brick.BChan.newBChan 10
-  let gameEnv = GameEnv eventChan
+runGame :: RunType -> Game.Config -> Game.GameState -> IO ()
+runGame rt _config gameState = do
+  _eventChan <- Brick.BChan.newBChan 10
+  let gameEnv = GameEnv {..}
   app <- makeApp gameEnv rt
   let buildVty = Vty.mkVty Vty.defaultConfig
   initialVty <- buildVty
   _game' <- customMain
     initialVty
     buildVty
-    (Just eventChan)
+    (Just _eventChan)
     app
     gameState
   pure ()