Allow specifying seed on startup

Allow specifying the seed for the game's global RNG on startup, and
print the seed when the game exits. This'll allow us to more reliably
reproduce bugs - yay!

src/Main.hs

@@ -1,25 +1,50 @@
 module Main ( main ) where
 --------------------------------------------------------------------------------
-import           Xanthous.Prelude
+import           Xanthous.Prelude hiding (finally)
 import           Brick
 import qualified Options.Applicative as Opt
 import           System.Random
+import           Control.Monad.Random (getRandom)
+import           Control.Exception (finally)
 --------------------------------------------------------------------------------
-import           Xanthous.Game (getInitialState)
+import qualified Xanthous.Game as Game
 import           Xanthous.App (makeApp)
 import           Xanthous.Generators
-  ( GeneratorInput
+                 ( GeneratorInput
-  , parseGeneratorInput
+                 , parseGeneratorInput
-  , generateFromInput
+                 , generateFromInput
-  , showCells
+                 , showCells
-  )
+                 )
+import qualified Xanthous.Entities.Character as Character
 import           Xanthous.Generators.Util (regions)
 import           Xanthous.Generators.LevelContents
 import           Xanthous.Data (Dimensions, Dimensions'(Dimensions))
 import           Data.Array.IArray ( amap )
 --------------------------------------------------------------------------------
+
+data RunParams = RunParams
+  { seed :: Maybe Int
+  , characterName :: Maybe Text
+  }
+  deriving stock (Show, Eq)
+
+parseRunParams :: Opt.Parser RunParams
+parseRunParams = RunParams
+  <$> optional (Opt.option Opt.auto
+      ( Opt.long "seed"
+      <> Opt.help "Random seed for the game."
+      ))
+  <*> optional (Opt.strOption
+      ( Opt.short 'n'
+      <> Opt.long "name"
+      <> Opt.help
+        ( "Name for the character. If not set on the command line, "
+        <> "will be prompted for at runtime"
+        )
+      ))
+
 data Command
-  = Run
+  = Run RunParams
   | Generate GeneratorInput Dimensions
 
 parseDimensions :: Opt.Parser Dimensions
@@ -34,10 +59,10 @@ parseDimensions = Dimensions
        )
 
 parseCommand :: Opt.Parser Command
-parseCommand = (<|> pure Run) $ Opt.subparser
+parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser
   $ Opt.command "run"
       (Opt.info
-       (pure Run)
+       (Run <$> parseRunParams)
        (Opt.progDesc "Run the game"))
   <> Opt.command "generate"
       (Opt.info
@@ -53,11 +78,20 @@ optParser = Opt.info
   (parseCommand <**> Opt.helper)
   (Opt.header "Xanthous: a WIP TUI RPG")
 
-runGame :: IO ()
+runGame :: RunParams -> IO ()
-runGame =  do
+runGame rparams = do
   app <- makeApp
-  initialState <- getInitialState
+  gameSeed <- maybe getRandom pure $ seed rparams
-  _ <- defaultMain app initialState
+  let initialState = Game.initialStateFromSeed gameSeed &~ do
+        for_ (characterName rparams) $ \cn ->
+          Game.character . Character.characterName ?= cn
+  _game' <- defaultMain app initialState `finally` do
+    putStr "\n\n"
+    putStrLn "Thanks for playing Xanthous!"
+    when (isNothing $ seed rparams)
+      . putStrLn
+      $ "Seed: " <> tshow gameSeed
+    putStr "\n\n"
   pure ()
 
 runGenerate :: GeneratorInput -> Dimensions -> IO ()
@@ -74,7 +108,7 @@ runGenerate input dims = do
   putStrLn $ showCells res
 
 runCommand :: Command -> IO ()
-runCommand Run = runGame
+runCommand (Run runParams) = runGame runParams
 runCommand (Generate input dims) = runGenerate input dims
 
 main :: IO ()

src/Xanthous/App.hs

@@ -64,10 +64,12 @@ startEvent :: AppM ()
 startEvent = do
   initLevel
   modify updateCharacterVision
-  prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
+  use (character . characterName) >>= \case
-    $ \(StringResult s) -> do
+    Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
-      character . characterName ?= s
+      $ \(StringResult s) -> do
-      say ["welcome"] =<< use character
+        character . characterName ?= s
+        say ["welcome"] =<< use character
+    Just n -> say ["welcome"] $ object [ "characterName" A..= n ]
 
 initLevel :: AppM ()
 initLevel = do
@@ -178,6 +180,7 @@ handleCommand Eat = do
             character . characterHitpoints +=
               edibleItem ^. hitpointsHealed . to fromIntegral
             message msg $ object ["item" A..= item]
+  stepGame
   continue
 
 handleCommand ToggleRevealAll = do
@@ -201,11 +204,11 @@ handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) =
 
 handlePromptEvent
   msg
-  (Prompt c SStringPrompt (StringPromptState edit) pi cb)
+  (Prompt c SStringPrompt (StringPromptState edit) pri cb)
   (VtyEvent ev)
   = do
     edit' <- lift $ handleEditorEvent ev edit
-    let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb
+    let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb
     promptState .= WaitingPrompt msg prompt'
     continue
 

src/Xanthous/Game.hs

@@ -8,6 +8,7 @@ module Xanthous.Game
   , GamePromptState(..)
 
   , getInitialState
+  , initialStateFromSeed
 
   , positionedCharacter
   , character

src/Xanthous/Game/Lenses.hs

@@ -6,6 +6,7 @@ module Xanthous.Game.Lenses
   , characterPosition
   , updateCharacterVision
   , getInitialState
+  , initialStateFromSeed
 
     -- * Collisions
   , Collision(..)
@@ -16,6 +17,7 @@ import           Xanthous.Prelude
 --------------------------------------------------------------------------------
 import           System.Random
 import           Control.Monad.State
+import           Control.Monad.Random (getRandom)
 --------------------------------------------------------------------------------
 import           Xanthous.Game.State
 import           Xanthous.Data
@@ -28,9 +30,12 @@ import           Xanthous.Entities.Creature (Creature)
 --------------------------------------------------------------------------------
 
 getInitialState :: IO GameState
-getInitialState = do
+getInitialState = initialStateFromSeed <$> getRandom
-  _randomGen <- getStdGen
+
-  let char = mkCharacter
+initialStateFromSeed :: Int -> GameState
+initialStateFromSeed seed =
+  let _randomGen = mkStdGen seed
+      char = mkCharacter
       (_characterEntityID, _entities)
         = EntityMap.insertAtReturningID
           (Position 0 0)
@@ -42,7 +47,7 @@ getInitialState = do
       _debugState = DebugState
         { _allRevealed = False
         }
-  pure GameState {..}
+  in GameState {..}
 
 
 positionedCharacter :: Lens' GameState (Positioned Character)