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.

1 files changed, 5 insertions, 16 deletions

diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 5c9130de386a..100204c755c3 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -92,6 +92,7 @@ import           Xanthous.Data.Levels
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import           Xanthous.Data.EntityChar
 import           Xanthous.Data.VectorBag
+import           Xanthous.Data.Entities
 import           Xanthous.Orphans ()
 import           Xanthous.Game.Prompt
 import           Xanthous.Resource
@@ -315,24 +316,12 @@ brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain)
 
 --------------------------------------------------------------------------------
 
-
-data Collision
-  = Stop   -- ^ Can't move through this
-  | Combat -- ^ Moving into this equates to hitting it with a stick
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData)
-
 class ( Show a, Eq a, Ord a, NFData a
       , ToJSON a, FromJSON a
       , Draw a, Brain a
       ) => Entity a where
-  blocksVision :: a -> Bool
-
-  -- | Does this entity block a large object from being put in the same tile as
-  -- it - eg a a door being closed on it
-  blocksObject :: a -> Bool
-  blocksObject = const False
-
+  entityAttributes :: a -> EntityAttributes
+  entityAttributes = const defaultEntityAttributes
   description :: a -> Text
   entityChar :: a -> EntityChar
   entityCollision :: a -> Maybe Collision
@@ -406,8 +395,8 @@ instance
   , Draw entity, Brain entity
   )
   => Entity (DeriveEntity blocksVision description entityChar entity) where
-
-  blocksVision _ = boolVal @blocksVision
+  entityAttributes _ = defaultEntityAttributes
+    & blocksVision .~ boolVal @blocksVision
   description _ = pack . symbolVal $ Proxy @description
   entityChar _ = fromString . symbolVal $ Proxy @entityChar