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.

16 files changed, 290 insertions, 74 deletions

diff --git a/package.yaml b/package.yaml
index aa1b52ed032e..35f6b5652660 100644
--- a/package.yaml
+++ b/package.yaml
@@ -48,6 +48,7 @@ dependencies:
 - reflection
 - stache
 - tomland
+- vector
 - vty
 - yaml
 
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 72c9a3f553ad..eb2f0cf7ad83 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -13,6 +13,7 @@ import           Control.Monad.Random (MonadRandom)
 import           Control.Monad.State.Class (modify)
 import           Data.Aeson (object, ToJSON)
 import qualified Data.Aeson as A
+import qualified Data.Vector as V
 import           System.Exit
 --------------------------------------------------------------------------------
 import           Xanthous.Command
@@ -29,16 +30,18 @@ import           Xanthous.Game.Draw (drawGame)
 import           Xanthous.Game.Prompt
 import           Xanthous.Monad
 import           Xanthous.Resource (Name)
-import           Xanthous.Messages (message)
+import qualified Xanthous.Messages as Messages
 import           Xanthous.Util.Inflection (toSentence)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Entities.Character as Character
 import           Xanthous.Entities.Character
 import           Xanthous.Entities
 import           Xanthous.Entities.Item (Item)
+import qualified Xanthous.Entities.Item as Item
 import           Xanthous.Entities.Creature (Creature)
 import qualified Xanthous.Entities.Creature as Creature
 import           Xanthous.Entities.Environment (Door, open, locked)
+import           Xanthous.Entities.RawTypes (edible, eatMessage, hitpointsHealed)
 import           Xanthous.Generators
 import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
 --------------------------------------------------------------------------------
@@ -155,6 +158,26 @@ handleCommand Open = do
 
 handleCommand Wait = stepGame >> continue
 
+handleCommand Eat = do
+  uses (character . inventory)
+       (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible))
+    >>= \case
+      Empty -> say_ ["eat", "noFood"]
+      food ->
+        let foodMenuItem idx (item, edibleItem)
+              = ( item ^. Item.itemType . char . char
+                , MenuOption (description item) (idx, item, edibleItem))
+            menuItems = mkMenuItems $ imap foodMenuItem food
+        in menu_ ["eat", "menuPrompt"] Cancellable menuItems
+          $ \(MenuResult (idx, item, edibleItem)) -> do
+            character . inventory %= \inv ->
+              let (before, after) = V.splitAt idx inv
+              in before <> fromMaybe Empty (tailMay after)
+            let msg = fromMaybe (Messages.lookup ["eat", "eat"])
+                      $ edibleItem ^. eatMessage
+            message msg $ object ["item" A..= item]
+  continue
+
 handleCommand ToggleRevealAll = do
   val <- debugState . allRevealed <%= not
   say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ]
@@ -168,39 +191,43 @@ handlePromptEvent
   -> BrickEvent Name ()
   -> AppM (Next GameState)
 
-handlePromptEvent _ (Prompt Cancellable _ _ _) (VtyEvent (EvKey KEsc [])) = do
-  promptState .= NoPrompt
-  continue
-handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do
-  submitPrompt pr
+handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) = do
   promptState .= NoPrompt
   continue
+handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) =
+  submitPrompt pr >> clearPrompt
 
 handlePromptEvent
   msg
-  (Prompt c SStringPrompt (StringPromptState edit) cb)
+  (Prompt c SStringPrompt (StringPromptState edit) pi cb)
   (VtyEvent ev)
   = do
     edit' <- lift $ handleEditorEvent ev edit
-    let prompt' = Prompt c SStringPrompt (StringPromptState edit') cb
+    let prompt' = Prompt c SStringPrompt (StringPromptState edit') pi cb
     promptState .= WaitingPrompt msg prompt'
     continue
 
-handlePromptEvent _ (Prompt _ SDirectionPrompt _ cb)
+handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb)
   (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
-  = do
-    cb $ DirectionResult dir
-    promptState .= NoPrompt
-    continue
-handlePromptEvent _ (Prompt _ SDirectionPrompt _ _) _ = continue
+  = cb (DirectionResult dir) >> clearPrompt
+handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue
 
-handlePromptEvent _ (Prompt _ SContinue _ _) _ = continue
+handlePromptEvent _ (Prompt _ SContinue _ _ _) _ = continue
+
+handlePromptEvent _ (Prompt _ SMenu _ items cb) (VtyEvent (EvKey (KChar chr) []))
+  | Just (MenuOption _ res) <- items ^. at chr
+  = cb (MenuResult res) >> clearPrompt
+  | otherwise
+  = continue
 
 handlePromptEvent _ _ _ = undefined
 
+clearPrompt :: AppM (Next GameState)
+clearPrompt = promptState .= NoPrompt >> continue
+
 prompt
   :: forall (pt :: PromptType) (params :: Type).
-    (ToJSON params, SingPromptType pt)
+    (ToJSON params, SingPromptType pt, PromptInput pt ~ ())
   => [Text]                     -- ^ Message key
   -> params                     -- ^ Message params
   -> PromptCancellable
@@ -208,19 +235,40 @@ prompt
   -> AppM ()
 prompt msgPath params cancellable cb = do
   let pt = singPromptType @pt
-  msg <- message msgPath params
+  msg <- Messages.message msgPath params
   let p = mkPrompt cancellable pt cb
   promptState .= WaitingPrompt msg p
 
 prompt_
   :: forall (pt :: PromptType) .
-    (SingPromptType pt)
+    (SingPromptType pt, PromptInput pt ~ ())
   => [Text] -- ^ Message key
   -> PromptCancellable
   -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler
   -> AppM ()
 prompt_ msg = prompt msg $ object []
 
+menu :: forall (a :: Type) (params :: Type).
+       (ToJSON params)
+     => [Text]                            -- ^ Message key
+     -> params                            -- ^ Message params
+     -> PromptCancellable
+     -> Map Char (MenuOption a)           -- ^ Menu items
+     -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler
+     -> AppM ()
+menu msgPath params cancellable items cb = do
+  msg <- Messages.message msgPath params
+  let p = mkMenu cancellable items cb
+  promptState .= WaitingPrompt msg p
+
+menu_ :: forall (a :: Type).
+        [Text]                            -- ^ Message key
+      -> PromptCancellable
+      -> Map Char (MenuOption a)           -- ^ Menu items
+      -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler
+      -> AppM ()
+menu_ msgPath = menu msgPath $ object []
+
 --------------------------------------------------------------------------------
 
 entitiesAtPositionWithType
diff --git a/src/Xanthous/Command.hs b/src/Xanthous/Command.hs
index 4bf0e2893908..f2f21160df75 100644
--- a/src/Xanthous/Command.hs
+++ b/src/Xanthous/Command.hs
@@ -16,6 +16,7 @@ data Command
   | PickUp
   | Open
   | Wait
+  | Eat
 
     -- | TODO replace with `:` commands
   | ToggleRevealAll
@@ -27,6 +28,7 @@ commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir
 commandFromKey (KChar 'p') [MCtrl] = Just PreviousMessage
 commandFromKey (KChar ',') [] = Just PickUp
 commandFromKey (KChar 'o') [] = Just Open
+commandFromKey (KChar 'e') [] = Just Eat
 commandFromKey (KChar 'r') [MMeta] = Just ToggleRevealAll
 commandFromKey _ _ = Nothing
 
diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs
index 15080b3221e0..af226b395d9e 100644
--- a/src/Xanthous/Entities.hs
+++ b/src/Xanthous/Entities.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE RoleAnnotations       #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE RoleAnnotations      #-}
+{-# LANGUAGE RecordWildCards      #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GADTs                #-}
+{-# LANGUAGE AllowAmbiguousTypes  #-}
+{-# LANGUAGE TemplateHaskell      #-}
 --------------------------------------------------------------------------------
 module Xanthous.Entities
   ( Draw(..)
@@ -103,6 +104,7 @@ data EntityChar = EntityChar
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
+makeFieldsNoPrefix ''EntityChar
 
 instance Arbitrary EntityChar where
   arbitrary = genericArbitrary
diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs
index 832f0d4d62b3..ea6f16e05dc3 100644
--- a/src/Xanthous/Entities/Item.hs
+++ b/src/Xanthous/Entities/Item.hs
@@ -5,6 +5,7 @@ module Xanthous.Entities.Item
   ( Item(..)
   , itemType
   , newWithType
+  , isEdible
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
@@ -12,7 +13,7 @@ import           Test.QuickCheck
 import           Data.Aeson (ToJSON, FromJSON)
 import           Data.Aeson.Generic.DerivingVia
 --------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes hiding (Item, description)
+import           Xanthous.Entities.RawTypes hiding (Item, description, isEdible)
 import qualified Xanthous.Entities.RawTypes as Raw
 import           Xanthous.Entities
                  ( Draw(..)
@@ -47,3 +48,6 @@ instance Entity Item where
 
 newWithType :: ItemType -> Item
 newWithType = Item
+
+isEdible :: Item -> Bool
+isEdible = Raw.isEdible . view itemType
diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs
index 3fb89c58ba3b..f1f5e05f7aac 100644
--- a/src/Xanthous/Entities/RawTypes.hs
+++ b/src/Xanthous/Entities/RawTypes.hs
@@ -3,14 +3,20 @@
 --------------------------------------------------------------------------------
 module Xanthous.Entities.RawTypes
   ( CreatureType(..)
+  , EdibleItem(..)
   , ItemType(..)
+  , isEdible
   , EntityRaw(..)
 
+    -- * Lens classes
   , HasName(..)
   , HasDescription(..)
   , HasLongDescription(..)
   , HasMaxHitpoints(..)
   , HasFriendly(..)
+  , HasEatMessage(..)
+  , HasHitpointsHealed(..)
+  , HasEdible(..)
   , _Creature
   ) where
 --------------------------------------------------------------------------------
@@ -21,6 +27,7 @@ import Data.Aeson.Generic.DerivingVia
 import Data.Aeson (ToJSON, FromJSON)
 --------------------------------------------------------------------------------
 import Xanthous.Entities (EntityChar, HasChar(..))
+import Xanthous.Messages (Message(..))
 --------------------------------------------------------------------------------
 data CreatureType = CreatureType
   { _name :: Text
@@ -41,11 +48,26 @@ instance Arbitrary CreatureType where
 
 --------------------------------------------------------------------------------
 
+data EdibleItem = EdibleItem
+  { _hitpointsHealed :: Int
+  , _eatMessage :: Maybe Message
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
+                       EdibleItem
+makeFieldsNoPrefix ''EdibleItem
+
+instance Arbitrary EdibleItem where
+  arbitrary = genericArbitrary
+
 data ItemType = ItemType
-  { _name :: Text
-  , _description :: Text
+  { _name            :: Text
+  , _description     :: Text
   , _longDescription :: Text
-  , _char :: EntityChar
+  , _char            :: EntityChar
+  , _edible          :: Maybe EdibleItem
   }
   deriving stock (Show, Eq, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
@@ -57,6 +79,11 @@ makeFieldsNoPrefix ''ItemType
 instance Arbitrary ItemType where
   arbitrary = genericArbitrary
 
+isEdible :: ItemType -> Bool
+isEdible = has $ edible . _Just
+
+--------------------------------------------------------------------------------
+
 data EntityRaw
   = Creature CreatureType
   | Item ItemType
diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml
index 91a0a35388ad..c3f19dce91d1 100644
--- a/src/Xanthous/Entities/Raws/noodles.yaml
+++ b/src/Xanthous/Entities/Raws/noodles.yaml
@@ -6,3 +6,7 @@ Item:
     char: 'n'
     style:
       foreground: yellow
+  edible:
+    hitpointsHealed: 2
+    eatMessage:
+      - You slurp up the noodles. Yumm!
diff --git a/src/Xanthous/Game/Draw.hs b/src/Xanthous/Game/Draw.hs
index addeaa14cd45..9f247d383325 100644
--- a/src/Xanthous/Game/Draw.hs
+++ b/src/Xanthous/Game/Draw.hs
@@ -37,13 +37,19 @@ drawMessages = txt . (<> " ") . unwords . oextract
 
 drawPromptState :: GamePromptState m -> Widget Name
 drawPromptState NoPrompt = emptyWidget
-drawPromptState (WaitingPrompt msg (Prompt _ pt ps _)) =
-  case (pt, ps) of
-    (SStringPrompt, StringPromptState edit) ->
+drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
+  case (pt, ps, pri) of
+    (SStringPrompt, StringPromptState edit, _) ->
       txt msg <+> renderEditor (txt . fold) True edit
-    (SDirectionPrompt, DirectionPromptState) -> txt msg
-    (SContinue, _) -> txt msg
+    (SDirectionPrompt, DirectionPromptState, _) -> txt msg
+    (SContinue, _, _) -> txt msg
+    (SMenu, _, menuItems) ->
+      txt msg
+      <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems)
     _ -> undefined
+  where
+    drawMenuItem (chr, MenuOption m _) =
+      str ("[" <> pure chr <> "] ") <+> txt m
 
 drawEntities
   :: (Position -> Bool)
diff --git a/src/Xanthous/Game/Prompt.hs b/src/Xanthous/Game/Prompt.hs
index cb34793c6d60..26a7b96eb1f2 100644
--- a/src/Xanthous/Game/Prompt.hs
+++ b/src/Xanthous/Game/Prompt.hs
@@ -8,20 +8,25 @@ module Xanthous.Game.Prompt
   , PromptCancellable(..)
   , PromptResult(..)
   , PromptState(..)
+  , MenuOption(..)
+  , mkMenuItems
+  , PromptInput
   , Prompt(..)
   , mkPrompt
+  , mkMenu
   , isCancellable
   , submitPrompt
   ) where
 --------------------------------------------------------------------------------
 import Xanthous.Prelude
 --------------------------------------------------------------------------------
-import Brick.Widgets.Edit (Editor, editorText, getEditContents)
-import Test.QuickCheck
-import Test.QuickCheck.Arbitrary.Generic
+import           Brick.Widgets.Edit (Editor, editorText, getEditContents)
+import           Test.QuickCheck
+import           Test.QuickCheck.Arbitrary.Generic
 --------------------------------------------------------------------------------
-import Xanthous.Data (Direction, Position)
-import Xanthous.Resource (Name)
+import           Xanthous.Util (smallestNotIn)
+import           Xanthous.Data (Direction, Position)
+import           Xanthous.Resource (Name)
 import qualified Xanthous.Resource as Resource
 --------------------------------------------------------------------------------
 
@@ -81,12 +86,31 @@ data PromptResult (pt :: PromptType) where
   ContinueResult   ::             PromptResult 'Continue
 
 data PromptState pt where
-  StringPromptState :: Editor Text Name -> PromptState 'StringPrompt
-  DirectionPromptState :: PromptState 'DirectionPrompt
-  ContinuePromptState :: PromptState 'Continue
+  StringPromptState    :: Editor Text Name -> PromptState 'StringPrompt
+  DirectionPromptState ::                    PromptState 'DirectionPrompt
+  ContinuePromptState  ::                    PromptState 'Continue
+  MenuPromptState      :: forall a.               PromptState ('Menu a)
 
 deriving stock instance Show (PromptState pt)
 
+data MenuOption a = MenuOption Text a
+
+mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a))
+            => f
+            -> Map Char (MenuOption a)
+mkMenuItems = flip foldl' mempty $ \items (chr, option) ->
+  let chr' = if has (ix chr) items
+             then smallestNotIn $ keys items
+             else chr
+  in items & at chr' ?~ option
+
+instance Show (MenuOption a) where
+  show (MenuOption m _) = show m
+
+type family PromptInput (pt :: PromptType) :: Type where
+  PromptInput ('Menu a) = Map Char (MenuOption a)
+  PromptInput _ = ()
+
 data Prompt (m :: Type -> Type) where
   Prompt
     :: forall (pt :: PromptType)
@@ -94,38 +118,53 @@ data Prompt (m :: Type -> Type) where
       PromptCancellable
     -> SPromptType pt
     -> PromptState pt
+    -> PromptInput pt
     -> (PromptResult pt -> m ())
     -> Prompt m
 
 instance Show (Prompt m) where
-  show (Prompt c pt ps _)
+  show (Prompt c pt ps pri _)
     = "(Prompt "
     <> show c <> " "
     <> show pt <> " "
-    <> show ps
-    <> " <function> )"
-
-mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m
+    <> show ps <> " "
+    <> showPri
+    <> " <function>)"
+    where showPri = case pt of
+            SMenu -> show pri
+            _ -> "()"
+
+mkPrompt :: (PromptInput pt ~ ()) => PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m
 mkPrompt c pt@SStringPrompt cb =
   let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
-  in Prompt c pt ps cb
-mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb
-mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState cb
+  in Prompt c pt ps () cb
+mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb
+mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb
 mkPrompt _ _ _ = undefined
 
+mkMenu
+  :: forall a m.
+    PromptCancellable
+  -> Map Char (MenuOption a) -- ^ Menu items
+  -> (PromptResult ('Menu a) -> m ())
+  -> Prompt m
+mkMenu c = Prompt c SMenu MenuPromptState
+
 isCancellable :: Prompt m -> Bool
-isCancellable (Prompt Cancellable _ _ _)   = True
-isCancellable (Prompt Uncancellable _ _ _) = False
+isCancellable (Prompt Cancellable _ _ _ _)   = True
+isCancellable (Prompt Uncancellable _ _ _ _) = False
 
 submitPrompt :: Applicative m => Prompt m -> m ()
-submitPrompt (Prompt _ pt ps cb) =
+submitPrompt (Prompt _ pt ps _ cb) =
   case (pt, ps) of
     (SStringPrompt, StringPromptState edit) ->
       cb . StringResult . mconcat . getEditContents $ edit
     (SDirectionPrompt, DirectionPromptState) ->
       pure () -- Don't use submit with a direction prompt
     (SContinue, ContinuePromptState) ->
-      cb ContinueResult -- Don't use submit with a direction prompt
+      cb ContinueResult
+    (SMenu, MenuPromptState) ->
+      pure () -- Don't use submit with a menu prompt
     _ -> undefined
 
 -- data PromptInput :: PromptType -> Type where
diff --git a/src/Xanthous/Messages.hs b/src/Xanthous/Messages.hs
index b1aeeb635cc9..b0dc0e4ae9d2 100644
--- a/src/Xanthous/Messages.hs
+++ b/src/Xanthous/Messages.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+--------------------------------------------------------------------------------
 module Xanthous.Messages
   ( Message(..)
   , resolve
@@ -7,11 +8,13 @@ module Xanthous.Messages
 
     -- * Game messages
   , messages
+  , render
+  , lookup
   , message
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
-
+import Xanthous.Prelude hiding (lookup)
+--------------------------------------------------------------------------------
 import Control.Monad.Random.Class (MonadRandom)
 import Data.Aeson (FromJSON, ToJSON, toJSON)
 import Data.Aeson.Generic.DerivingVia
@@ -22,9 +25,10 @@ import Test.QuickCheck.Arbitrary.Generic
 import Test.QuickCheck.Instances.UnorderedContainers ()
 import Text.Mustache
 import qualified Data.Yaml as Yaml
-
+--------------------------------------------------------------------------------
 import Xanthous.Random
 import Xanthous.Orphans ()
+--------------------------------------------------------------------------------
 
 data Message = Single Template | Choice (NonEmpty Template)
   deriving stock (Show, Eq, Ord, Generic)
@@ -78,10 +82,19 @@ messages
   = either (error . Yaml.prettyPrintParseException) id
   $ Yaml.decodeEither' rawMessages
 
+render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text
+render msg params = do
+  tpl <- resolve msg
+  pure . toStrict . renderMustache tpl $ toJSON params
+
+lookup :: [Text] -> Message
+lookup path = fromMaybe notFound $ messages ^? ix path
+  where notFound
+          = Single
+          $ compileMustacheText "template" "Message not found"
+          ^?! _Right
+
 message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text
-message path params = maybe notFound renderMessage $ messages ^? ix path
+message path params = maybe notFound (`render` params) $ messages ^? ix path
   where
-    renderMessage msg = do
-      tpl <- resolve msg
-      pure . toStrict . renderMustache tpl $ toJSON params
     notFound = pure "Message not found"
diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs
index 3e567ee8fa5e..c11cb0e2d4df 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 []
diff --git a/src/Xanthous/Util.hs b/src/Xanthous/Util.hs
index d90cf5b03d3d..3a7c10ace18e 100644
--- a/src/Xanthous/Util.hs
+++ b/src/Xanthous/Util.hs
@@ -24,6 +24,7 @@ module Xanthous.Util
   , uniq
     -- ** Bag sequence algorithms
   , takeWhileInclusive
+  , smallestNotIn
   ) where
 
 import Xanthous.Prelude hiding (foldr)
@@ -194,3 +195,12 @@ uniq = uniqOf folded
 takeWhileInclusive :: (a -> Bool) -> [a] -> [a]
 takeWhileInclusive _ [] = []
 takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else []
+
+-- | Returns the smallest value not in a list
+smallestNotIn :: (Ord a, Bounded a, Enum a) => [a] -> a
+smallestNotIn xs = case uniq $ sort xs of
+  [] -> minBound
+  xs'@(x : _)
+    | x > minBound -> minBound
+    | otherwise
+    -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..]
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index 8f761ba6e76d..1d8e066ed7a6 100644
--- a/src/Xanthous/messages.yaml
+++ b/src/Xanthous/messages.yaml
@@ -1,5 +1,9 @@
 welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside?
-dead: You have died... Press Enter to continue.
+dead:
+  - You have died...
+  - You die...
+  - You perish...
+  - You have perished...
 
 entities:
   description: You see here {{entityDescriptions}}
@@ -18,10 +22,10 @@ character:
   namePrompt: "What's your name? "
 
 combat:
-  nothingToAttack: There's nothing to attack there
+  nothingToAttack: There's nothing to attack there.
   hit:
-    - You hit the {{creature.creatureType.name}}
-    - You attack the {{creature.creatureType.name}}
+    - You hit the {{creature.creatureType.name}}.
+    - You attack the {{creature.creatureType.name}}.
   creatureAttack:
     - The {{creature.creatureType.name}} hits you!
     - The {{creature.creatureType.name}} attacks you!
@@ -31,3 +35,12 @@ combat:
 
 debug:
   toggleRevealAll: revealAll now set to {{revealAll}}
+
+eat:
+  noFood:
+    - You have nothing edible.
+    - You don't have any food.
+    - You don't have anything to eat.
+    - You search your pockets for something edible, and come up short.
+  menuPrompt: What would you like to eat?
+  eat: You eat the {{item.itemType.name}}.
diff --git a/test/Spec.hs b/test/Spec.hs
index 7af988a3d7e3..27e26862e255 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -6,6 +6,7 @@ import qualified Xanthous.GameSpec
 import qualified Xanthous.Generators.UtilSpec
 import qualified Xanthous.MessageSpec
 import qualified Xanthous.OrphansSpec
+import qualified Xanthous.UtilSpec
 import qualified Xanthous.Util.GraphicsSpec
 import qualified Xanthous.Util.InflectionSpec
 
@@ -21,6 +22,7 @@ test = testGroup "Xanthous"
   , Xanthous.MessageSpec.test
   , Xanthous.OrphansSpec.test
   , Xanthous.DataSpec.test
+  , Xanthous.UtilSpec.test
   , Xanthous.Util.GraphicsSpec.test
   , Xanthous.Util.InflectionSpec.test
   ]
diff --git a/test/Xanthous/UtilSpec.hs b/test/Xanthous/UtilSpec.hs
new file mode 100644
index 000000000000..1cfca1ffca76
--- /dev/null
+++ b/test/Xanthous/UtilSpec.hs
@@ -0,0 +1,24 @@
+module Xanthous.UtilSpec (main, test) where
+
+import Test.Prelude
+import Xanthous.Util
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util"
+  [ testGroup "smallestNotIn"
+    [ testCase "examples" $ do
+        smallestNotIn [7 :: Word, 3, 7] @?= 0
+        smallestNotIn [7 :: Word, 0, 1, 3, 7] @?= 2
+    , testProperty "returns an element not in the list" $ \(xs :: [Word]) ->
+        smallestNotIn xs `notElem` xs
+    , testProperty "pred return is in the list" $ \(xs :: [Word]) ->
+        let res = smallestNotIn xs
+        in res /= 0 ==> pred res `elem` xs
+    , testProperty "ignores order" $ \(xs :: [Word]) ->
+        forAll (shuffle xs) $ \shuffledXs ->
+          smallestNotIn xs === smallestNotIn shuffledXs
+    ]
+  ]
diff --git a/xanthous.cabal b/xanthous.cabal
index 022b6442094e..f25521c5bb09 100644
--- a/xanthous.cabal
+++ b/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: ad4acf50f6be0dc7ae6c68d9920b61c2d32b5d759aae7311a124d159b4a9bc7f
+-- hash: ac15bf59fd57f7a0bc23f010aec83824f819592494145cbce3e1db36e23f1107
 
 name:           xanthous
 version:        0.1.0.0
@@ -103,6 +103,7 @@ library
     , reflection
     , stache
     , tomland
+    , vector
     , vty
     , yaml
   default-language: Haskell2010
@@ -183,6 +184,7 @@ executable xanthous
     , reflection
     , stache
     , tomland
+    , vector
     , vty
     , xanthous
     , yaml
@@ -202,6 +204,7 @@ test-suite test
       Xanthous.OrphansSpec
       Xanthous.Util.GraphicsSpec
       Xanthous.Util.InflectionSpec
+      Xanthous.UtilSpec
       Paths_xanthous
   hs-source-dirs:
       test
@@ -244,6 +247,7 @@ test-suite test
     , tasty-hunit
     , tasty-quickcheck
     , tomland
+    , vector
     , vty
     , xanthous
     , yaml