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…
	
	Add table
		Add a link
		
	
		Reference in a new issue