Link up messages to the overall game

Add a "say" function for saying messages within an app monad to the
user, and link everything up to display them and track their history

1 files changed, 52 insertions, 16 deletions

diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index f30f753439..39066c23b6 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -3,46 +3,82 @@
 module Xanthous.Game
   ( GameState(..)
   , entities
+  , messageHistory
+  , randomGen
+
   , getInitialState
 
   , positionedCharacter
   , character
   , characterPosition
+
+  , MessageHistory(..)
+  , pushMessage
   ) where
 
-import Xanthous.Prelude
-import Test.QuickCheck.Arbitrary
+import           Data.List.NonEmpty ( NonEmpty((:|)))
+import qualified Data.List.NonEmpty as NonEmpty
+import           System.Random
+import           Test.QuickCheck
+import           Test.QuickCheck.Arbitrary.Generic
+import           Xanthous.Prelude
 
-import Xanthous.Data.EntityMap (EntityMap, EntityID)
+import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import qualified Xanthous.Data.EntityMap as EntityMap
-import Xanthous.Data (Positioned, Position(..), positioned, position)
-import Xanthous.Entities.SomeEntity
-import Xanthous.Entities.Character
+import           Xanthous.Data (Positioned, Position(..), positioned, position)
+import           Xanthous.Entities.SomeEntity
+import           Xanthous.Entities.Character
+import           Xanthous.Orphans ()
+
+data MessageHistory
+  = NoMessageHistory
+  | MessageHistory (NonEmpty Text) Bool
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+
+instance Arbitrary MessageHistory where
+  arbitrary = genericArbitrary
+
+pushMessage :: Text -> MessageHistory -> MessageHistory
+pushMessage msg NoMessageHistory = MessageHistory (msg :| []) True
+pushMessage msg (MessageHistory msgs _) = MessageHistory (NonEmpty.cons msg msgs) True
 
 data GameState = GameState
   { _entities          :: EntityMap SomeEntity
   , _characterEntityID :: EntityID
+  , _messageHistory    :: MessageHistory
+  , _randomGen         :: StdGen
   }
-  deriving stock (Show, Eq)
+  deriving stock (Show)
 makeLenses ''GameState
 
+instance Eq GameState where
+  (GameState es₁ ceid₁ mh₁ _) == (GameState es₂ ceid₂ mh₂ _)
+    = es₁ == es₂
+    && ceid₁ == ceid₂
+    && mh₁ == mh₂
+
 instance Arbitrary GameState where
   arbitrary = do
-    ents <- arbitrary
-    char <- arbitrary
-    pure $ getInitialState
-      & entities .~ ents
-      & positionedCharacter .~ char
-
-getInitialState :: GameState
-getInitialState =
+    char <- arbitrary @Character
+    charPos <- arbitrary
+    _messageHistory <- arbitrary
+    (_characterEntityID, _entities) <- arbitrary <&>
+      EntityMap.insertAtReturningID charPos (SomeEntity char)
+    _randomGen <- mkStdGen <$> arbitrary
+    pure $ GameState {..}
+
+getInitialState :: IO GameState
+getInitialState = do
+  _randomGen <- getStdGen
   let char = mkCharacter
       (_characterEntityID, _entities)
         = EntityMap.insertAtReturningID
           (Position 0 0)
           (SomeEntity char)
           mempty
-  in GameState {..}
+      _messageHistory = NoMessageHistory
+  pure GameState {..}
 
 positionedCharacter :: Lens' GameState (Positioned Character)
 positionedCharacter = lens getPositionedCharacter setPositionedCharacter