Factor out an EntityAttributes type

Factor out a new EntityAttributes type from some of the methods of the
Entity class, to avoid the proliferation of 1-argument boolean methods
on the entity class that always have to be forwarded through the Entity
instance for SomeEntity if they have defaults (forgetting to do which
has wasted tons of my time up to this point). Currently blocksVision,
blocksObject, and collision are all in there.

5 files changed, 11 insertions, 11 deletions

diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 43d4f8a52942..424488828c75 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -84,7 +84,7 @@ instance Draw WieldedItem where
   draw = draw . view wieldedItem
 
 instance Entity WieldedItem where
-  blocksVision = blocksVision . view wieldedItem
+  entityAttributes = entityAttributes . view wieldedItem
   description = description . view wieldedItem
   entityChar = entityChar . view wieldedItem
 
@@ -232,7 +232,6 @@ instance Brain Character where
     else hp + hitpointRecoveryRate |*| ticks
 
 instance Entity Character where
-  blocksVision _ = False
   description _ = "yourself"
   entityChar _ = "@"
 
diff --git a/src/Xanthous/Entities/Creature.hs b/src/Xanthous/Entities/Creature.hs
index cc07b3560c2c..e95e9f0b985b 100644
--- a/src/Xanthous/Entities/Creature.hs
+++ b/src/Xanthous/Entities/Creature.hs
@@ -40,6 +40,7 @@ import           Xanthous.Entities.RawTypes hiding
 import qualified Xanthous.Entities.RawTypes as Raw
 import           Xanthous.Game.State
 import           Xanthous.Data
+import           Xanthous.Data.Entities
 import           Xanthous.Entities.Creature.Hippocampus
 --------------------------------------------------------------------------------
 
@@ -65,8 +66,8 @@ instance Brain Creature where
   entityCanMove = const True
 
 instance Entity Creature where
-  blocksVision _ = False
-  blocksObject _ = True
+  entityAttributes _ = defaultEntityAttributes
+    & blocksObject .~ True
   description = view $ creatureType . Raw.description
   entityChar = view $ creatureType . char
   entityCollision = const $ Just Combat
diff --git a/src/Xanthous/Entities/Entities.hs b/src/Xanthous/Entities/Entities.hs
index 710e577be866..55991fc28428 100644
--- a/src/Xanthous/Entities/Entities.hs
+++ b/src/Xanthous/Entities/Entities.hs
@@ -46,8 +46,7 @@ deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState
   instance FromJSON GameState
 
 instance Entity SomeEntity where
-  blocksVision (SomeEntity ent) = blocksVision ent
-  blocksObject (SomeEntity ent) = blocksObject ent
+  entityAttributes (SomeEntity ent) = entityAttributes ent
   description (SomeEntity ent) = description ent
   entityChar (SomeEntity ent) = entityChar ent
   entityCollision (SomeEntity ent) = entityCollision ent
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
index 430ce1b7a99e..b45a91eabed2 100644
--- a/src/Xanthous/Entities/Environment.hs
+++ b/src/Xanthous/Entities/Environment.hs
@@ -29,6 +29,7 @@ import Data.Aeson.Generic.DerivingVia
 --------------------------------------------------------------------------------
 import Xanthous.Entities.Draw.Util
 import Xanthous.Data
+import Xanthous.Data.Entities
 import Xanthous.Game.State
 import Xanthous.Util.QuickCheck
 --------------------------------------------------------------------------------
@@ -48,7 +49,9 @@ instance FromJSON Wall where
 instance Brain Wall where step = brainVia Brainless
 
 instance Entity Wall where
-  blocksVision _ = True
+  entityAttributes _ = defaultEntityAttributes
+    & blocksVision .~ True
+    & blocksObject .~ True
   description _ = "a wall"
   entityChar _ = "┼"
 
@@ -93,7 +96,8 @@ instance Draw Door where
 instance Brain Door where step = brainVia Brainless
 
 instance Entity Door where
-  blocksVision = not . view open
+  entityAttributes door = defaultEntityAttributes
+    & blocksVision .~ not (door ^. open)
   description door | door ^. open = "an open door"
                    | otherwise    = "a closed door"
   entityChar _ = "d"
@@ -127,7 +131,6 @@ newtype GroundMessage = GroundMessage Text
 instance Brain GroundMessage where step = brainVia Brainless
 
 instance Entity GroundMessage where
-  blocksVision = const False
   description = const "a message on the ground. Press r. to read it."
   entityChar = const "≈"
   entityCollision = const Nothing
@@ -150,7 +153,6 @@ instance Draw Staircase where
   draw DownStaircase = str ">"
 
 instance Entity Staircase where
-  blocksVision = const False
   description UpStaircase = "a staircase leading upwards"
   description DownStaircase = "a staircase leading downwards"
   entityChar UpStaircase = "<"
diff --git a/src/Xanthous/Entities/Item.hs b/src/Xanthous/Entities/Item.hs
index cedd75507a70..b50a5eab809d 100644
--- a/src/Xanthous/Entities/Item.hs
+++ b/src/Xanthous/Entities/Item.hs
@@ -38,7 +38,6 @@ instance Arbitrary Item where
   arbitrary = Item <$> arbitrary
 
 instance Entity Item where
-  blocksVision _ = False
   description = view $ itemType . Raw.description
   entityChar = view $ itemType . Raw.char
   entityCollision = const Nothing