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.

3 files changed, 30 insertions, 1 deletions

diff --git a/test/Spec.hs b/test/Spec.hs
index ba8f868a8172..3790f3ce65ba 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -5,6 +5,7 @@ import qualified Xanthous.Data.EntityCharSpec
 import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.EntityMap.GraphicsSpec
 import qualified Xanthous.Data.LevelsSpec
+import qualified Xanthous.Data.EntitiesSpec
 import qualified Xanthous.DataSpec
 import qualified Xanthous.Entities.RawsSpec
 import qualified Xanthous.GameSpec
@@ -26,6 +27,7 @@ test = testGroup "Xanthous"
   , Xanthous.Data.EntityMapSpec.test
   , Xanthous.Data.EntityMap.GraphicsSpec.test
   , Xanthous.Data.LevelsSpec.test
+  , Xanthous.Data.EntitiesSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
   , Xanthous.Generators.UtilSpec.test
diff --git a/test/Xanthous/Data/EntitiesSpec.hs b/test/Xanthous/Data/EntitiesSpec.hs
new file mode 100644
index 000000000000..e403503743c0
--- /dev/null
+++ b/test/Xanthous/Data/EntitiesSpec.hs
@@ -0,0 +1,28 @@
+--------------------------------------------------------------------------------
+module Xanthous.Data.EntitiesSpec (main, test) where
+--------------------------------------------------------------------------------
+import           Test.Prelude
+--------------------------------------------------------------------------------
+import qualified Data.Aeson as JSON
+--------------------------------------------------------------------------------
+import           Xanthous.Data.Entities
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Data.Entities"
+  [ testGroup "Collision"
+    [ testProperty "JSON round-trip" $ \(c :: Collision) ->
+        JSON.decode (JSON.encode c) === Just c
+    , testGroup "JSON encoding examples"
+      [ testCase "Stop" $ JSON.encode Stop @?= "\"Stop\""
+      , testCase "Combat" $ JSON.encode Combat @?= "\"Combat\""
+      ]
+    ]
+  , testGroup "EntityAttributes"
+    [ testProperty "JSON round-trip" $ \(ea :: EntityAttributes) ->
+        JSON.decode (JSON.encode ea) === Just ea
+    ]
+  ]
diff --git a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
index 6b736be4ee21..9347a1c1b569 100644
--- a/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
+++ b/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
@@ -42,6 +42,5 @@ instance Brain TestEntity where
   step _ = pure
 instance Draw TestEntity
 instance Entity TestEntity where
-  blocksVision _ = False
   description _ = ""
   entityChar _ = "e"