feat(gs/xanthous): Default to the current save file r/3008

When saving, default to the save file that was loaded for the game if
any. To support this, this also makes text prompts support a default,
which will be used if no value is input.

Change-Id: I72a826499d6e987b939e3465a2d29167e53416be
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3801
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

1 files changed, 36 insertions, 16 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs
index 0674d853beb7..2d6c0a280f41 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs
@@ -16,6 +16,8 @@ module Xanthous.Game.Prompt
   , PromptInput
   , Prompt(..)
   , mkPrompt
+  , mkStringPrompt
+  , mkStringPromptWithDefault
   , mkMenu
   , mkPointOnMapPrompt
   , mkFirePrompt
@@ -215,9 +217,10 @@ instance Show (MenuOption a) where
   show (MenuOption m _) = show m
 
 type family PromptInput (pt :: PromptType) :: Type where
-  PromptInput ('Menu a)   = Map Char (MenuOption a)
-  PromptInput 'PointOnMap = Position -- Character pos
-  PromptInput 'Fire       = (Position, Tiles) -- Nearest enemy, range
+  PromptInput ('Menu a)     = Map Char (MenuOption a)
+  PromptInput 'PointOnMap   = Position -- Character pos
+  PromptInput 'Fire         = (Position, Tiles) -- Nearest enemy, range
+  PromptInput 'StringPrompt = Maybe Text -- Default value
   PromptInput _ = ()
 
 data Prompt (m :: Type -> Type) where
@@ -286,13 +289,27 @@ mkPrompt
   -> SPromptType pt          -- ^ The type of the prompt
   -> (PromptResult pt -> m ()) -- ^ Function to call when the prompt is complete
   -> Prompt m
-mkPrompt c pt@SStringPrompt cb =
-  let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
-  in Prompt c pt ps () cb
 mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb
 mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb
 mkPrompt c pt@SConfirm cb = Prompt c pt ConfirmPromptState () cb
 
+mkStringPrompt
+  :: PromptCancellable                  -- ^ Is the prompt cancellable or not?
+  -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete
+  -> Prompt m
+mkStringPrompt c =
+  let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
+  in Prompt c SStringPrompt ps Nothing
+
+mkStringPromptWithDefault
+  :: PromptCancellable                  -- ^ Is the prompt cancellable or not?
+  -> Text                               -- ^ Default value for the prompt
+  -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete
+  -> Prompt m
+mkStringPromptWithDefault c def =
+  let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
+  in Prompt c SStringPrompt ps (Just def)
+
 mkMenu
   :: forall a m.
     PromptCancellable
@@ -321,19 +338,22 @@ isCancellable (Prompt Cancellable _ _ _ _)   = True
 isCancellable (Prompt Uncancellable _ _ _ _) = False
 
 submitPrompt :: Applicative m => Prompt m -> m ()
-submitPrompt (Prompt _ pt ps _ cb) =
-  case (pt, ps) of
-    (SStringPrompt, StringPromptState edit) ->
-      cb . StringResult . mconcat . getEditContents $ edit
-    (SDirectionPrompt, DirectionPromptState) ->
+submitPrompt (Prompt _ pt ps pri cb) =
+  case (pt, ps, pri) of
+    (SStringPrompt, StringPromptState edit, mDef) ->
+      let inputVal = mconcat . getEditContents $ edit
+          val | null inputVal, Just def <- mDef = def
+              | otherwise = inputVal
+      in cb $ StringResult val
+    (SDirectionPrompt, DirectionPromptState, _) ->
       pure () -- Don't use submit with a direction prompt
-    (SContinue, ContinuePromptState) ->
+    (SContinue, ContinuePromptState, _) ->
       cb ContinueResult
-    (SMenu, MenuPromptState) ->
+    (SMenu, MenuPromptState, _) ->
       pure () -- Don't use submit with a menu prompt
-    (SPointOnMap, PointOnMapPromptState pos) ->
+    (SPointOnMap, PointOnMapPromptState pos, _) ->
       cb $ PointOnMapResult pos
-    (SConfirm, ConfirmPromptState) ->
+    (SConfirm, ConfirmPromptState, _) ->
       cb $ ConfirmResult True
-    (SFire, FirePromptState pos) ->
+    (SFire, FirePromptState pos, _) ->
       cb $ FireResult pos