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.

3 files changed, 39 insertions, 4 deletions

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!