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, 20 insertions, 9 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index ae88a746cec6..c543ad468f6d 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -1,35 +1,46 @@
 module Xanthous.App (makeApp) where
 
 import Xanthous.Prelude
-import Brick hiding (App)
+import Brick hiding (App, halt, continue)
 import qualified Brick
 import Graphics.Vty.Attributes (defAttr)
 import Graphics.Vty.Input.Events (Event(EvKey))
+import Control.Monad.State (get)
 
 import Xanthous.Game
 import Xanthous.Game.Draw (drawGame)
 import Xanthous.Resource (Name)
 import Xanthous.Command
 import Xanthous.Data (move)
+import Xanthous.Monad
 
 type App = Brick.App GameState () Name
+type AppM a = AppT (EventM Name) a
 
 makeApp :: IO App
 makeApp = pure $ Brick.App
   { appDraw = drawGame
   , appChooseCursor = const headMay
-  , appHandleEvent = handleEvent
-  , appStartEvent = pure
+  , appHandleEvent = \state event -> runAppM (handleEvent event) state
+  , appStartEvent = runAppM $ startEvent >> get
   , appAttrMap = const $ attrMap defAttr []
   }
 
-handleEvent :: GameState -> BrickEvent Name () -> EventM Name (Next GameState)
-handleEvent game (VtyEvent (EvKey k mods))
+runAppM :: AppM a -> GameState -> EventM Name a
+runAppM appm = fmap fst . runAppT appm
+
+startEvent :: AppM ()
+startEvent = say ["welcome"]
+
+handleEvent :: BrickEvent Name () -> AppM (Next GameState)
+handleEvent (VtyEvent (EvKey k mods))
   | Just command <- commandFromKey k mods
-  = handleCommand command game
-handleEvent game _ = continue game
+  = handleCommand command
+handleEvent _ = continue
 
-handleCommand :: Command -> GameState -> EventM Name (Next GameState)
+handleCommand :: Command -> AppM (Next GameState)
 handleCommand Quit = halt
-handleCommand (Move dir) = continue . (characterPosition %~ move dir)
+handleCommand (Move dir) = do
+  characterPosition %= move dir
+  continue
 handleCommand _ = error "unimplemented"