diff options
| -rw-r--r-- | package.yaml | 1 | ||||
| -rw-r--r-- | src/Xanthous/App.hs | 29 | ||||
| -rw-r--r-- | src/Xanthous/messages.yaml | 4 | ||||
| -rw-r--r-- | xanthous.cabal | 5 |
4 files changed, 25 insertions, 14 deletions
diff --git a/package.yaml b/package.yaml index 32a402f3fdad..8d761b58e055 100644 --- a/package.yaml +++ b/package.yaml @@ -30,6 +30,7 @@ dependencies: - containers - data-default - deepseq +- directory - fgl - fgl-arbitrary - file-embed 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? diff --git a/xanthous.cabal b/xanthous.cabal index 23044d7fce02..f173b1a114a9 100644 --- a/xanthous.cabal +++ b/xanthous.cabal @@ -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 |