Prompt before overwriting files when saving

When saving the game to a file that already exists, prompt for whether
or not to overwrite the file.

Since this was the first instance of a prompt triggered by another
prompt, this also had to do a minor fix to swap the order of completing
the prompt and clearing it, so that we don't submit the prompt and then
immediately clear it.

2 files changed, 20 insertions, 13 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 5fb70bd075b6..808654e1abe3 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -16,6 +16,7 @@ import           Data.Aeson (object, ToJSON)
 import qualified Data.Aeson as A
 import qualified Data.Vector as V
 import           System.Exit
+import           System.Directory (doesFileExist)
 import           GHC.TypeLits (TypeError, ErrorMessage(..))
 --------------------------------------------------------------------------------
 import           Xanthous.Command
@@ -257,13 +258,19 @@ handleCommand Save = do
   -- TODO default save locations / config file?
   prompt_ @'StringPrompt ["save", "location"] Cancellable
     $ \(StringResult filename) -> do
+       exists <- liftIO . doesFileExist $ unpack filename
+       if exists
+       then confirm ["save", "overwrite"] (object ["filename" A..= filename])
+            $ doSave filename
+       else doSave filename
+  continue
+  where
+    doSave filename = do
       src <- gets saveGame
       lift . liftIO $ do
         writeFile (unpack filename) $ toStrict src
         exitSuccess
 
-  continue
-
 
 handleCommand ToggleRevealAll = do
   val <- debugState . allRevealed <%= not
@@ -279,15 +286,15 @@ handlePromptEvent
   -> AppM (Next GameState)
 
 handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc []))
-  = clearPrompt
+  = clearPrompt >> continue
 handlePromptEvent _ pr (VtyEvent (EvKey KEnter []))
-  = submitPrompt pr >> clearPrompt
+  = clearPrompt >> submitPrompt pr >> continue
 
 handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') []))
-  = submitPrompt pr >> clearPrompt
+  = clearPrompt >> submitPrompt pr >> continue
 
 handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') []))
-  = clearPrompt
+  = clearPrompt >> continue
 
 handlePromptEvent
   msg
@@ -301,12 +308,12 @@ handlePromptEvent
 
 handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb)
   (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
-  = cb (DirectionResult dir) >> clearPrompt
+  = clearPrompt >> cb (DirectionResult dir) >> continue
 handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue
 
 handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) []))
   | Just (MenuOption _ res) <- items' ^. at chr
-  = cb (MenuResult res) >> clearPrompt
+  = clearPrompt >> cb (MenuResult res) >> continue
   | otherwise
   = continue
 
@@ -324,11 +331,11 @@ handlePromptEvent
   _
   (Prompt Cancellable _ _ _ _)
   (VtyEvent (EvKey (KChar 'q') []))
-  = clearPrompt
+  = clearPrompt >> continue
 handlePromptEvent _ _ _ = continue
 
-clearPrompt :: AppM (Next GameState)
-clearPrompt = promptState .= NoPrompt >> continue
+clearPrompt :: AppM ()
+clearPrompt = promptState .= NoPrompt
 
 class NotMenu (pt :: PromptType)
 instance NotMenu 'StringPrompt
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index 408cb6a1a57b..1a4159b0ac6a 100644
--- a/src/Xanthous/messages.yaml
+++ b/src/Xanthous/messages.yaml
@@ -9,8 +9,8 @@ generic:
   continue: Press enter to continue...
 
 save:
-  location:
-    "Enter filename to save to: "
+  location: "Enter filename to save to: "
+  overwrite: "A file named {{filename}} already exists. Would you like to overwrite it? "
 
 quit:
   confirm: Really quit without saving?