Allow eating edible items

Add menu support to the prompt system, and an "Eat" command that prompts
for an item to eat and eats the item the character specifies, restoring
an amount of hitpoints configurable via the item raw type.

1 files changed, 27 insertions, 10 deletions

diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs
index 3e567ee8fa..c11cb0e2d4 100644
--- a/src/Xanthous/Monad.hs
+++ b/src/Xanthous/Monad.hs
@@ -1,22 +1,28 @@
+--------------------------------------------------------------------------------
 module Xanthous.Monad
   ( AppT(..)
   , AppM
   , runAppT
   , continue
   , halt
+    -- * Messages
   , say
   , say_
+  , message
+  , message_
   ) where
-
-import Xanthous.Prelude
-import Control.Monad.Random
-import Control.Monad.State
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+import           Control.Monad.Random
+import           Control.Monad.State
 import qualified Brick
-import Brick (EventM, Next)
-import Data.Aeson
-
-import Xanthous.Game.State
-import Xanthous.Messages (message)
+import           Brick (EventM, Next)
+import           Data.Aeson
+--------------------------------------------------------------------------------
+import           Xanthous.Game.State
+import           Xanthous.Messages (Message)
+import qualified Xanthous.Messages as Messages
+--------------------------------------------------------------------------------
 
 runAppT :: Monad m => AppT m a -> GameState -> m (a, GameState)
 runAppT appt initialState = flip runStateT initialState . unAppT $ appt
@@ -27,12 +33,23 @@ halt = lift . Brick.halt =<< get
 continue :: AppT (EventM n) (Next GameState)
 continue = lift . Brick.continue =<< get
 
+--------------------------------------------------------------------------------
 
 say :: (MonadRandom m, ToJSON params, MonadState GameState m)
     => [Text] -> params -> m ()
 say msgPath params = do
-  msg <- message msgPath params
+  msg <- Messages.message msgPath params
   messageHistory %= pushMessage msg
 
 say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m ()
 say_ msgPath = say msgPath $ object []
+
+message :: (MonadRandom m, ToJSON params, MonadState GameState m)
+        => Message -> params -> m ()
+message msg params = do
+  m <- Messages.render msg params
+  messageHistory %= pushMessage m
+
+message_ :: (MonadRandom m, MonadState GameState m)
+         => Message ->  m ()
+message_ msg = message msg $ object []