Describe what you see when you walk over items

Every step the character takes, describe the entities at that position
excluding the character.

12 files changed, 82 insertions, 14 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index df0b30c41b5f..fce2beed13c1 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -8,7 +8,8 @@ import qualified Brick
 import           Brick.Widgets.Edit (handleEditorEvent)
 import           Graphics.Vty.Attributes (defAttr)
 import           Graphics.Vty.Input.Events (Event(EvKey), Key(..))
-import           Control.Monad.State (get, state, StateT(..))
+import           Control.Monad.State (get, state, StateT(..), MonadState)
+import           Control.Monad.Random (MonadRandom)
 import           Data.Coerce
 import           Control.Monad.State.Class (modify)
 import           Data.Aeson (object, ToJSON)
@@ -29,12 +30,14 @@ import           Xanthous.Game.Prompt
 import           Xanthous.Monad
 import           Xanthous.Resource (Name)
 import           Xanthous.Messages (message)
+import           Xanthous.Util.Inflection (toSentence)
 --------------------------------------------------------------------------------
 import qualified Xanthous.Entities.Character as Character
 import           Xanthous.Entities.Character (characterName)
 import           Xanthous.Entities
 import           Xanthous.Entities.Item (Item)
 import           Xanthous.Entities.Environment (Door, open, locked)
+import           Xanthous.Entities.Character
 import           Xanthous.Generators
 import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
 --------------------------------------------------------------------------------
@@ -93,6 +96,7 @@ handleCommand (Move dir) = do
   collisionAt newPos >>= \case
     Nothing -> do
       characterPosition .= newPos
+      describeEntitiesAt newPos
       modify updateCharacterVision
     Just Combat -> undefined
     Just Stop -> pure ()
@@ -198,3 +202,15 @@ entitiesAtPositionWithType pos em =
     case downcastEntity @a se of
       Just e  -> [(eid, e)]
       Nothing -> []
+
+describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m ()
+describeEntitiesAt pos =
+  use ( entities
+      . EntityMap.atPosition pos
+      . to (filter (not . entityIs @Character))
+      ) >>= \case
+        Empty -> pure ()
+        ents  ->
+          let descriptions = description <$> ents
+          in say ["entities", "description"] $ object
+                 ["entityDescriptions" A..= toSentence descriptions]
diff --git a/src/Xanthous/Entities.hs b/src/Xanthous/Entities.hs
index e47e820f27ab..66a583f6b3fd 100644
--- a/src/Xanthous/Entities.hs
+++ b/src/Xanthous/Entities.hs
@@ -38,9 +38,11 @@ import           Xanthous.Orphans ()
 
 class (Show a, Eq a, Draw a) => Entity a where
   blocksVision :: a -> Bool
+  description :: a -> Text
 
 instance Entity a => Entity (Positioned a) where
   blocksVision (Positioned _ ent) = blocksVision ent
+  description (Positioned _ ent) = description ent
 
 --------------------------------------------------------------------------------
 data SomeEntity where
@@ -59,6 +61,7 @@ instance Draw SomeEntity where
 
 instance Entity SomeEntity where
   blocksVision (SomeEntity ent) = blocksVision ent
+  description (SomeEntity ent) = description ent
 
 downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a
 downcastEntity (SomeEntity e) = cast e
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 695d7bb0d0d1..924c1857a8ae 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -41,6 +41,7 @@ instance Draw Character where
 
 instance Entity Character where
   blocksVision _ = False
+  description _ = "yourself"
 
 instance Arbitrary Character where
   arbitrary = genericArbitrary
diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index b59cceab4045..c660a6cdf5d4 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -9,13 +9,14 @@ module Xanthous.Entities.Creature
   , damage
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
+import           Xanthous.Prelude
 --------------------------------------------------------------------------------
-import Data.Word
-import Test.QuickCheck.Arbitrary.Generic
+import           Data.Word
+import           Test.QuickCheck.Arbitrary.Generic
 --------------------------------------------------------------------------------
-import Xanthous.Entities.RawTypes hiding (Creature)
-import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
+import           Xanthous.Entities.RawTypes hiding (Creature, description)
+import qualified Xanthous.Entities.RawTypes as Raw
+import           Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
 --------------------------------------------------------------------------------
 
 data Creature = Creature
@@ -31,6 +32,7 @@ instance Arbitrary Creature where
 
 instance Entity Creature where
   blocksVision _ = False
+  description = view $ creatureType . Raw.description
 
 newWithType :: CreatureType -> Creature
 newWithType _creatureType =
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
index d9275266b0f4..4ef67a577dbb 100644
--- a/src/Xanthous/Entities/Environment.hs
+++ b/src/Xanthous/Entities/Environment.hs
@@ -24,6 +24,7 @@ data Wall = Wall
 
 instance Entity Wall where
   blocksVision _ = True
+  description _ = "a wall"
 
 instance Arbitrary Wall where
   arbitrary = pure Wall
@@ -65,3 +66,4 @@ instance Draw Door where
 
 instance Entity Door where
   blocksVision = not . view open
+  description _ = "a door"
diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs
index baf4be2f5426..6b50f50ad83c 100644
--- a/src/Xanthous/Entities/Item.hs
+++ b/src/Xanthous/Entities/Item.hs
@@ -1,17 +1,19 @@
 {-# LANGUAGE TemplateHaskell #-}
+--------------------------------------------------------------------------------
 module Xanthous.Entities.Item
   ( Item(..)
   , itemType
   , newWithType
   ) where
 --------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Test.QuickCheck
-import Data.Aeson (ToJSON, FromJSON)
-import Data.Aeson.Generic.DerivingVia
+import           Xanthous.Prelude
+import           Test.QuickCheck
+import           Data.Aeson (ToJSON, FromJSON)
+import           Data.Aeson.Generic.DerivingVia
 --------------------------------------------------------------------------------
-import Xanthous.Entities.RawTypes hiding (Item)
-import Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
+import           Xanthous.Entities.RawTypes hiding (Item, description)
+import qualified Xanthous.Entities.RawTypes as Raw
+import           Xanthous.Entities (Draw(..), Entity(..), DrawRawChar(..))
 --------------------------------------------------------------------------------
 
 data Item = Item
@@ -30,6 +32,7 @@ instance Arbitrary Item where
 
 instance Entity Item where
   blocksVision _ = False
+  description = view $ itemType . Raw.description
 
 newWithType :: ItemType -> Item
 newWithType = Item
diff --git a/src/Xanthous/Entities/Raws/noodles.yaml b/src/Xanthous/Entities/Raws/noodles.yaml
index 120087d48357..91a0a35388ad 100644
--- a/src/Xanthous/Entities/Raws/noodles.yaml
+++ b/src/Xanthous/Entities/Raws/noodles.yaml
@@ -1,6 +1,6 @@
 Item:
   name: noodles
-  description: a big bowl o' noodles
+  description: "a big bowl o' noodles"
   longDescription: You know exactly what kind of noodles
   char:
     char: 'n'
diff --git a/src/Xanthous/Util/Inflection.hs b/src/Xanthous/Util/Inflection.hs
new file mode 100644
index 000000000000..fc66c0876125
--- /dev/null
+++ b/src/Xanthous/Util/Inflection.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE ViewPatterns #-}
+
+module Xanthous.Util.Inflection
+  ( toSentence
+  ) where
+
+import Xanthous.Prelude
+
+toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text
+toSentence xs = case reverse . toList $ xs of
+  [] -> ""
+  [x] -> x
+  [b, a] -> a <> " and " <> b
+  (final : butlast) ->
+    intercalate ", " (reverse butlast) <> ", and " <> final
diff --git a/src/Xanthous/messages.yaml b/src/Xanthous/messages.yaml
index ef4f09543d49..4d7b0003fac7 100644
--- a/src/Xanthous/messages.yaml
+++ b/src/Xanthous/messages.yaml
@@ -1,5 +1,8 @@
 welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside?
 
+entities:
+  description: You see here {{entityDescriptions}}
+
 items:
   pickUp: You pick up the {{item.itemType.name}}
   nothingToPickUp: "There's nothing here to pick up"
diff --git a/test/Spec.hs b/test/Spec.hs
index cac474053ccb..7af988a3d7e3 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -7,6 +7,7 @@ import qualified Xanthous.Generators.UtilSpec
 import qualified Xanthous.MessageSpec
 import qualified Xanthous.OrphansSpec
 import qualified Xanthous.Util.GraphicsSpec
+import qualified Xanthous.Util.InflectionSpec
 
 main :: IO ()
 main = defaultMain test
@@ -21,4 +22,5 @@ test = testGroup "Xanthous"
   , Xanthous.OrphansSpec.test
   , Xanthous.DataSpec.test
   , Xanthous.Util.GraphicsSpec.test
+  , Xanthous.Util.InflectionSpec.test
   ]
diff --git a/test/Xanthous/Util/InflectionSpec.hs b/test/Xanthous/Util/InflectionSpec.hs
new file mode 100644
index 000000000000..fad841043152
--- /dev/null
+++ b/test/Xanthous/Util/InflectionSpec.hs
@@ -0,0 +1,18 @@
+module Xanthous.Util.InflectionSpec (main, test) where
+
+import Test.Prelude
+import Xanthous.Util.Inflection
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Util.Inflection"
+  [ testGroup "toSentence"
+    [ testCase "empty"  $ toSentence [] @?= ""
+    , testCase "single" $ toSentence ["x"] @?= "x"
+    , testCase "two"    $ toSentence ["x", "y"] @?= "x and y"
+    , testCase "three"  $ toSentence ["x", "y", "z"] @?= "x, y, and z"
+    , testCase "four"   $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w"
+    ]
+  ]
diff --git a/xanthous.cabal b/xanthous.cabal
index cb89323b2b08..c7b19155dde4 100644
--- a/xanthous.cabal
+++ b/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 40187d0301465905043b8caafec5465e644f711620c9fc1cfc57af4105ebe08c
+-- hash: cebd0598e7aa48a62741fd8a9acc462bb693bb9356947147e0604d8e4b395739
 
 name:           xanthous
 version:        0.1.0.0
@@ -59,6 +59,7 @@ library
       Xanthous.Resource
       Xanthous.Util
       Xanthous.Util.Graphics
+      Xanthous.Util.Inflection
   other-modules:
       Paths_xanthous
   hs-source-dirs:
@@ -132,6 +133,7 @@ executable xanthous
       Xanthous.Resource
       Xanthous.Util
       Xanthous.Util.Graphics
+      Xanthous.Util.Inflection
       Paths_xanthous
   hs-source-dirs:
       src
@@ -185,6 +187,7 @@ test-suite test
       Xanthous.MessageSpec
       Xanthous.OrphansSpec
       Xanthous.Util.GraphicsSpec
+      Xanthous.Util.InflectionSpec
       Paths_xanthous
   hs-source-dirs:
       test