From bf7d139c1a17fe55921fb807aa249e93288d3e4d Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Mon, 23 Dec 2019 10:59:45 -0500
Subject: [PATCH] Use attack messages when attacking

When attacking, use either:
- the message defined on the entity raw of the wielded item, if any
- the generic attack message, if an item without an attack message is wielded
- the fists attack message, if no item is wielded
---
 src/Xanthous/App.hs   | 14 ++++++++++----
 src/Xanthous/Monad.hs | 12 ++++++------
 2 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index b278eec23..6b1c2413c 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -49,7 +49,7 @@ import           Xanthous.Entities.Environment
                  (Door, open, locked, GroundMessage(..))
 import           Xanthous.Entities.RawTypes
                  ( edible, eatMessage, hitpointsHealed
-                 , wieldable
+                 , wieldable, attackMessage
                  )
 import           Xanthous.Generators
 import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
@@ -439,10 +439,17 @@ attackAt pos =
         say ["combat", "killed"] msgParams
         entities . at creatureID .= Nothing
       else do
-        -- TODO attack messages
-        say ["combat", "hit", "generic"] msgParams
+        msg <- uses character getAttackMessage
+        message msg msgParams
         entities . ix creatureID . positioned .= SomeEntity creature'
     stepGame -- TODO
+  getAttackMessage chr =
+    case chr ^? inventory . wielded . wieldedItems . wieldableItem of
+      Just wi ->
+        fromMaybe (Messages.lookup ["combat", "hit", "generic"])
+        $ wi ^. attackMessage
+      Nothing ->
+        Messages.lookup ["combat", "hit", "fists"]
 
 entityMenu_
   :: (Comonad w, Entity entity)
@@ -462,7 +469,6 @@ entityMenuChar entity
         then ec
         else 'a'
 
-
 -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
 -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity
 
diff --git a/src/Xanthous/Monad.hs b/src/Xanthous/Monad.hs
index c11cb0e2d..1138a7a5a 100644
--- a/src/Xanthous/Monad.hs
+++ b/src/Xanthous/Monad.hs
@@ -10,6 +10,7 @@ module Xanthous.Monad
   , say_
   , message
   , message_
+  , writeMessage
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude
@@ -37,19 +38,18 @@ continue = lift . Brick.continue =<< get
 
 say :: (MonadRandom m, ToJSON params, MonadState GameState m)
     => [Text] -> params -> m ()
-say msgPath params = do
-  msg <- Messages.message msgPath params
-  messageHistory %= pushMessage msg
+say msgPath = writeMessage <=< Messages.message msgPath
 
 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 msg = writeMessage <=< Messages.render msg
 
 message_ :: (MonadRandom m, MonadState GameState m)
          => Message ->  m ()
 message_ msg = message msg $ object []
+
+writeMessage :: MonadState GameState m => Text -> m ()
+writeMessage m = messageHistory %= pushMessage m