feat(xanthous): Add configurable natural attacks r/2674

Allow configuring the natural attacks (eg, part of their body rather
than an item) of a creature. Each attack has a description and a damage
associated with it.

Change-Id: I69698a8ac4ee2da91e4c88e419593627519522a5
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3220
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

7 files changed, 69 insertions, 12 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs
index a7938c12254c..59be5383de55 100644
--- a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs
+++ b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs
@@ -24,7 +24,10 @@ import           Xanthous.Entities.Creature.Hippocampus
 import           Xanthous.Entities.Character (Character)
 import qualified Xanthous.Entities.Character as Character
 import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Entities.RawTypes (CreatureType, HasLanguage (language), getLanguage)
+import           Xanthous.Entities.RawTypes
+                 ( CreatureType, HasLanguage(language), getLanguage
+                 , HasAttacks (attacks)
+                 )
 import           Xanthous.Game.State
 import           Xanthous.Game.Lenses
                  ( entitiesCollision, collisionAt
@@ -36,6 +39,7 @@ import           Xanthous.Random
 import           Xanthous.Monad (say)
 import           Xanthous.Generators.Speech (word)
 import qualified Linear.Metric as Metric
+import qualified Xanthous.Messages as Messages
 --------------------------------------------------------------------------------
 
 --  TODO move the following two classes to a more central location
@@ -86,7 +90,7 @@ stepGormlak ticks pe@(Positioned pos creature) = do
          $ creature ^. field @"_hippocampus" . destination
   let progress' =
         dest ^. destinationProgress
-        + creature ^. field @"_creatureType" . Raw.speed . invertedRate |*| ticks
+        + creatureType ^. Raw.speed . invertedRate |*| ticks
   if progress' < 1
     then pure
          $ pe'
@@ -106,10 +110,17 @@ stepGormlak ticks pe@(Positioned pos creature) = do
           when (any (entityIs @Character) ents) attackCharacter
           pure pe'
   where
+    creatureType = creature ^. field @"_creatureType"
     vision = visionRadius creature
     attackCharacter = do
-      say ["combat", "creatureAttack"] $ object [ "creature" A..= creature ]
-      character %= Character.damage 1
+      attack <- choose $ creatureType ^. attacks
+      attackDescription <- Messages.render (attack ^. Raw.description)
+                          $ object []
+      say ["combat", "creatureAttack"]
+        $ object [ "creature" A..= creature
+                 , "attackDescription" A..= attackDescription
+                 ]
+      character %= Character.damage (attack ^. Raw.damage)
 
     yellAtCharacter = for_ (creature ^. field @"_creatureType" . language)
       $ \lang -> do
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
index ea5a90136e4e..b7c5fe31c995 100644
--- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
+++ b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
@@ -13,6 +13,8 @@ module Xanthous.Entities.RawTypes
     -- ** Language
   , LanguageName(..)
   , getLanguage
+    -- ** Attacks
+  , Attack(..)
 
     -- * Items
   , ItemType(..)
@@ -25,6 +27,7 @@ module Xanthous.Entities.RawTypes
   , isWieldable
 
     -- * Lens classes
+  , HasAttacks(..)
   , HasAttackMessage(..)
   , HasChar(..)
   , HasDamage(..)
@@ -52,6 +55,7 @@ import Xanthous.Data (TicksPerTile, Hitpoints)
 import Xanthous.Data.EntityChar
 import Xanthous.Util.QuickCheck
 import Xanthous.Generators.Speech (Language, gormlak, english)
+import Xanthous.Orphans ()
 --------------------------------------------------------------------------------
 
 -- | Identifiers for languages that creatures can speak.
@@ -73,6 +77,23 @@ getLanguage :: LanguageName -> Language
 getLanguage Gormlak = gormlak
 getLanguage English = english
 
+-- | Natural attacks for creature types
+data Attack = Attack
+  { -- | the @{{creature}}@ @{{description}}@
+    _description :: !Message
+    -- | Damage dealt
+  , _damage      :: !Hitpoints
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary Attack
+  deriving (ToJSON, FromJSON)
+       via WithOptions '[ FieldLabelModifier '[Drop 1]
+                        , OmitNothingFields 'True
+                        ]
+                       Attack
+makeFieldsNoPrefix ''Attack
+
 data CreatureType = CreatureType
   { _name         :: !Text
   , _description  :: !Text
@@ -81,8 +102,10 @@ data CreatureType = CreatureType
   , _friendly     :: !Bool
   , _speed        :: !TicksPerTile
   , _language     :: !(Maybe LanguageName)
-  , _sayVerb      :: !(Maybe Text) -- ^ The verb, in present tense, for when the
-                                  -- creature says something
+  , -- | The verb, in present tense, for when the creature says something
+    _sayVerb      :: !(Maybe Text)
+  , -- | The creature's natural attacks
+    _attacks       :: !(NonNull (Vector Attack))
   }
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
index 8cddf85394a6..ad3d9cb147da 100644
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
+++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
@@ -2,8 +2,8 @@ Creature:
   name: gormlak
   description: a gormlak
   longDescription: |
-    A chittering imp-like creature with bright yellow horns. It adores shiny objects
-    and gathers in swarms.
+    A chittering imp-like creature with bright yellow horns and sharp claws. It
+    adores shiny objects and gathers in swarms.
   char:
     char: g
     style:
@@ -13,3 +13,8 @@ Creature:
   friendly: false
   language: Gormlak
   sayVerb: yells
+  attacks:
+  - description:
+      - claws you
+      - slashes you with its claws
+    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
index d13b5881dfdc..fe427c94abf7 100644
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
+++ b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
@@ -10,3 +10,6 @@ Creature:
   maxHitpoints: 3
   speed: 100
   friendly: false
+  attacks:
+  - description: slams into you
+    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Messages.hs b/users/grfn/xanthous/src/Xanthous/Messages.hs
index 2b1b3da1e8c1..985694139783 100644
--- a/users/grfn/xanthous/src/Xanthous/Messages.hs
+++ b/users/grfn/xanthous/src/Xanthous/Messages.hs
@@ -9,6 +9,7 @@ module Xanthous.Messages
     -- * Game messages
   , messages
   , render
+  , render_
   , lookup
   , message
   , message_
@@ -17,7 +18,7 @@ module Xanthous.Messages
 import Xanthous.Prelude hiding (lookup)
 --------------------------------------------------------------------------------
 import           Control.Monad.Random.Class (MonadRandom)
-import           Data.Aeson (FromJSON, ToJSON, toJSON)
+import           Data.Aeson (FromJSON, ToJSON, toJSON, object)
 import qualified Data.Aeson as JSON
 import           Data.Aeson.Generic.DerivingVia
 import           Data.FileEmbed
@@ -89,6 +90,10 @@ render msg params = do
   tpl <- resolve msg
   pure . toStrict . renderMustache tpl $ toJSON params
 
+-- | Render a message with an empty set of params
+render_ :: (MonadRandom m) => Message -> m Text
+render_ msg = render msg $ object []
+
 lookup :: [Text] -> Message
 lookup path = fromMaybe notFound $ messages ^? ix path
   where notFound
diff --git a/users/grfn/xanthous/src/Xanthous/Orphans.hs b/users/grfn/xanthous/src/Xanthous/Orphans.hs
index 2a9a7a7ebc29..e6ea1310319b 100644
--- a/users/grfn/xanthous/src/Xanthous/Orphans.hs
+++ b/users/grfn/xanthous/src/Xanthous/Orphans.hs
@@ -300,9 +300,21 @@ deriving stock instance Ord Attr
 
 --------------------------------------------------------------------------------
 
+instance (SemiSequence a, Arbitrary (Element a), Arbitrary a)
+         => Arbitrary (NonNull a) where
+  arbitrary = ncons <$> arbitrary <*> arbitrary
+
+instance ToJSON a => ToJSON (NonNull a) where
+  toJSON = toJSON . toNullable
+
+instance (FromJSON a, MonoFoldable a) => FromJSON (NonNull a) where
+  parseJSON = maybe (fail "Found empty list") pure . fromNullable <=< parseJSON
+
 instance NFData a => NFData (NonNull a) where
   rnf xs = xs `seq` toNullable xs `deepseq` ()
 
+--------------------------------------------------------------------------------
+
 instance forall t name. (NFData t, Monoid t, NFData name)
                  => NFData (Editor t name) where
   rnf ed = getName @_ @name ed `deepseq` getEditContents ed `deepseq` ()
diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml
index 63763b199634..4f5dff52f6d0 100644
--- a/users/grfn/xanthous/src/Xanthous/messages.yaml
+++ b/users/grfn/xanthous/src/Xanthous/messages.yaml
@@ -71,9 +71,7 @@ combat:
     generic:
       - 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!
+  creatureAttack: The {{creature.creatureType.name}} {{attackDescription}}
   killed:
     - You kill the {{creature.creatureType.name}}!
     - You've killed the {{creature.creatureType.name}}!