diff --git a/package.yaml b/package.yaml index 32a402f3f..8d761b58e 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 5fb70bd07..808654e1a 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 408cb6a1a..1a4159b0a 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 23044d7fc..f173b1a11 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