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.
This commit is contained in:
parent
7e6234e2e9
commit
ffc8e793d5
4 changed files with 25 additions and 14 deletions
|
@ -30,6 +30,7 @@ dependencies:
|
|||
- containers
|
||||
- data-default
|
||||
- deepseq
|
||||
- directory
|
||||
- fgl
|
||||
- fgl-arbitrary
|
||||
- file-embed
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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?
|
||||
|
|
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 497414a98a626a63a6c5022688b33d0021c1580c7c262fbc1152599289df7935
|
||||
-- hash: a4f6c2c91e3c94c81de5d6b27201cb22e7f9f9c5d8a4f14beec63c1540d01ca1
|
||||
|
||||
name: xanthous
|
||||
version: 0.1.0.0
|
||||
|
@ -92,6 +92,7 @@ library
|
|||
, containers
|
||||
, data-default
|
||||
, deepseq
|
||||
, directory
|
||||
, fgl
|
||||
, fgl-arbitrary
|
||||
, file-embed
|
||||
|
@ -191,6 +192,7 @@ executable xanthous
|
|||
, containers
|
||||
, data-default
|
||||
, deepseq
|
||||
, directory
|
||||
, fgl
|
||||
, fgl-arbitrary
|
||||
, file-embed
|
||||
|
@ -265,6 +267,7 @@ test-suite test
|
|||
, containers
|
||||
, data-default
|
||||
, deepseq
|
||||
, directory
|
||||
, fgl
|
||||
, fgl-arbitrary
|
||||
, file-embed
|
||||
|
|
Loading…
Reference in a new issue