Add debug command to reveal the game

Add a (debug) command to reveal all tiles on the game regardless of the
character's vision, which'll make it easier to debug creature's behavior
while they're not visible.

1 files changed, 21 insertions, 2 deletions

diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 9b81abe35247..00785bf12440 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -32,6 +32,11 @@ module Xanthous.Game.State
   , downcastEntity
   , _SomeEntity
   , entityIs
+
+    -- * Debug State
+  , DebugState(..)
+  , debugState
+  , allRevealed
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
@@ -158,10 +163,10 @@ instance Entity SomeEntity where
   blocksVision (SomeEntity ent) = blocksVision ent
   description (SomeEntity ent) = description ent
 
-downcastEntity :: forall a. (Entity a, Typeable a) => SomeEntity -> Maybe a
+downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a
 downcastEntity (SomeEntity e) = cast e
 
-entityIs :: forall a. (Entity a, Typeable a) => SomeEntity -> Bool
+entityIs :: forall (a :: Type). (Typeable a) => SomeEntity -> Bool
 entityIs = isJust . downcastEntity @a
 
 _SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a
@@ -169,6 +174,15 @@ _SomeEntity = prism' SomeEntity downcastEntity
 
 --------------------------------------------------------------------------------
 
+data DebugState = DebugState
+  { _allRevealed :: !Bool
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+
+instance Arbitrary DebugState where
+  arbitrary = genericArbitrary
+
 data GameState = GameState
   { _entities          :: !(EntityMap SomeEntity)
   , _revealedPositions :: !(Set Position)
@@ -176,6 +190,7 @@ data GameState = GameState
   , _messageHistory    :: !MessageHistory
   , _randomGen         :: !StdGen
   , _promptState       :: !(GamePromptState AppM)
+  , _debugState        :: DebugState
   }
   deriving stock (Show)
 makeLenses ''GameState
@@ -198,3 +213,7 @@ instance (Monad m) => MonadRandom (AppT m) where
   getRandom = randomGen %%= random
   getRandomRs rng = uses randomGen $ randomRs rng
   getRandoms = uses randomGen randoms
+
+--------------------------------------------------------------------------------
+
+makeLenses ''DebugState