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

5 files changed, 48 insertions, 18 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs
index bb9b64b0b303..679bfe54597f 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs
@@ -43,6 +43,7 @@ instance Arbitrary GameState where
     _debugState <- arbitrary
     let _autocommand = NoAutocommand
     _memo <- arbitrary
+    _savefile <- arbitrary
     pure $ GameState {..}
 
 
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
index 25b1b92e215c..b9590ba40438 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
@@ -43,8 +43,12 @@ drawPromptState :: GamePromptState m -> Widget ResourceName
 drawPromptState NoPrompt = emptyWidget
 drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
   case (pt, ps, pri) of
-    (SStringPrompt, StringPromptState edit, _) ->
-      txtWrap msg <+> txt " " <+> renderEditor (txt . fold) True edit
+    (SStringPrompt, StringPromptState edit, mDef) ->
+      txtWrap msg
+      <+> txt " "
+      <+> txt (maybe "" (\def -> "(default: " <> def <> ")") mDef)
+      <+> txt " "
+      <+> renderEditor (txt . fold) True edit
     (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg
     (SMenu, _, menuItems) ->
       txtWrap msg
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs
index fd60e3637cc9..c692a3b47944 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs
@@ -65,6 +65,7 @@ initialStateFromSeed seed =
       _debugState = DebugState
         { _allRevealed = False
         }
+      _savefile = Nothing
       _autocommand = NoAutocommand
       _memo = emptyMemoState
   in GameState {..}
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
diff --git a/users/grfn/xanthous/src/Xanthous/Game/State.hs b/users/grfn/xanthous/src/Xanthous/Game/State.hs
index 10883ce06e40..3025eb15be5a 100644
--- a/users/grfn/xanthous/src/Xanthous/Game/State.hs
+++ b/users/grfn/xanthous/src/Xanthous/Game/State.hs
@@ -16,6 +16,7 @@ module Xanthous.Game.State
   , promptState
   , characterEntityID
   , autocommand
+  , savefile
   , memo
   , GamePromptState(..)
 
@@ -512,6 +513,9 @@ data GameState = GameState
   , _debugState        :: !DebugState
   , _autocommand       :: !AutocommandState
 
+  -- | The path to the savefile that was loaded for this game, if any
+  , _savefile          :: !(Maybe FilePath)
+
   , _memo              :: MemoState
   }
   deriving stock (Show, Generic)