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.

package.yaml

@@ -48,6 +48,7 @@ dependencies:
 - reflection
 - stache
 - tomland
+- vector
 - vty
 - yaml
 

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
+handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc [])) = do
-  promptState .= NoPrompt
-  continue
-handlePromptEvent _ pr (VtyEvent (EvKey KEnter [])) = do
-  submitPrompt pr
   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) >> clearPrompt
-    cb $ DirectionResult dir
+handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue
-    promptState .= NoPrompt
-    continue
-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

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
 

src/Xanthous/Entities.hs

@@ -1,8 +1,9 @@
-{-# LANGUAGE RoleAnnotations       #-}
+{-# LANGUAGE RoleAnnotations      #-}
-{-# LANGUAGE RecordWildCards       #-}
+{-# LANGUAGE RecordWildCards      #-}
-{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE GADTs                 #-}
+{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# 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

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

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
+  { _name            :: Text
-  , _description :: 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

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!

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 _)) =
+drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
-  case (pt, ps) of
+  case (pt, ps, pri) of
-    (SStringPrompt, StringPromptState edit) ->
+    (SStringPrompt, StringPromptState edit, _) ->
       txt msg <+> renderEditor (txt . fold) True edit
-    (SDirectionPrompt, DirectionPromptState) -> txt msg
+    (SDirectionPrompt, DirectionPromptState, _) -> txt msg
-    (SContinue, _) -> 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)

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           Brick.Widgets.Edit (Editor, editorText, getEditContents)
-import Test.QuickCheck
+import           Test.QuickCheck
-import Test.QuickCheck.Arbitrary.Generic
+import           Test.QuickCheck.Arbitrary.Generic
 --------------------------------------------------------------------------------
-import Xanthous.Data (Direction, Position)
+import           Xanthous.Util (smallestNotIn)
-import Xanthous.Resource (Name)
+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
+  StringPromptState    :: Editor Text Name -> PromptState 'StringPrompt
-  DirectionPromptState :: PromptState 'DirectionPrompt
+  DirectionPromptState ::                    PromptState 'DirectionPrompt
-  ContinuePromptState :: PromptState 'Continue
+  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
+    <> show ps <> " "
-    <> " <function> )"
+    <> showPri
+    <> " <function>)"
+    where showPri = case pt of
+            SMenu -> show pri
+            _ -> "()"
 
-mkPrompt :: PromptCancellable -> SPromptType pt -> (PromptResult pt -> m ()) -> Prompt m
+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
+  in Prompt c pt ps () cb
-mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState cb
+mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb
-mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState 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 Cancellable _ _ _ _)   = True
-isCancellable (Prompt Uncancellable _ _ _) = False
+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

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"

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           Xanthous.Prelude
-import Control.Monad.Random
+import           Control.Monad.Random
-import Control.Monad.State
+import           Control.Monad.State
 import qualified Brick
-import Brick (EventM, Next)
+import           Brick (EventM, Next)
-import Data.Aeson
+import           Data.Aeson
-
+--------------------------------------------------------------------------------
-import Xanthous.Game.State
+import           Xanthous.Game.State
-import Xanthous.Messages (message)
+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 []

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..]

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 hit the {{creature.creatureType.name}}.
-    - You attack 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}}.

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
   ]

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
+    ]
+  ]

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