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, 28 insertions, 25 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs
index 9318c713478b..78f9e76775d9 100644
--- a/users/grfn/xanthous/src/Xanthous/App.hs
+++ b/users/grfn/xanthous/src/Xanthous/App.hs
@@ -332,31 +332,34 @@ handleCommand Fire = do
       let enemies = los >>= \(_, es) -> toList $ headMay es
       in enemies ^? folded . below _SomeEntity
 
-handleCommand Save = do
-  -- TODO default save locations / config file?
-  use savefile >>= \case
-    Just filepath ->
-      stringPromptWithDefault_
-        ["save", "location"]
-        Cancellable
-        (pack filepath)
-        promptCallback
-    Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback
-  continue
-  where
-    promptCallback :: PromptResult 'StringPrompt -> AppM ()
-    promptCallback (StringResult filename) = do
-      sf <- use savefile
-      exists <- liftIO . doesFileExist $ unpack filename
-      if exists && sf /= Just (unpack filename)
-      then confirm ["save", "overwrite"] (object ["filename" A..= filename])
-          $ doSave filename
-      else doSave filename
-    doSave filename = do
-      src <- gets saveGame
-      lift . liftIO $ do
-        writeFile (unpack filename) $ toStrict src
-        exitSuccess
+handleCommand Save =
+  view (config . disableSaving) >>= \case
+    True -> say_ ["save", "disabled"] >> continue
+    False -> do
+      -- TODO default save locations / config file?
+      use savefile >>= \case
+        Just filepath ->
+          stringPromptWithDefault_
+            ["save", "location"]
+            Cancellable
+            (pack filepath)
+            promptCallback
+        Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback
+      continue
+      where
+        promptCallback :: PromptResult 'StringPrompt -> AppM ()
+        promptCallback (StringResult filename) = do
+          sf <- use savefile
+          exists <- liftIO . doesFileExist $ unpack filename
+          if exists && sf /= Just (unpack filename)
+          then confirm ["save", "overwrite"] (object ["filename" A..= filename])
+              $ doSave filename
+          else doSave filename
+        doSave filename = do
+          src <- gets saveGame
+          lift . liftIO $ do
+            writeFile (unpack filename) $ toStrict src
+            exitSuccess
 
 handleCommand GoUp = do
   hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase)