6 files changed, 81 insertions, 39 deletions
diff --git a/src/Xanthous/Entities/Arbitrary.hs b/src/Xanthous/Entities/Arbitrary.hs
new file mode 100644
index 000000000000..9153722d9b12
--- /dev/null
+++ b/src/Xanthous/Entities/Arbitrary.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+--------------------------------------------------------------------------------
+module Xanthous.Entities.Arbitrary () where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude
+--------------------------------------------------------------------------------
+import           Test.QuickCheck
+import qualified Test.QuickCheck.Gen as Gen
+--------------------------------------------------------------------------------
+import           Xanthous.Entities (SomeEntity(..))
+import           Xanthous.Entities.Character
+import           Xanthous.Entities.Environment
+--------------------------------------------------------------------------------
+
+instance Arbitrary SomeEntity where
+  arbitrary = Gen.oneof
+    [ pure $ SomeEntity Character
+    , pure $ SomeEntity Wall
+    ]
diff --git a/src/Xanthous/Entities/Character.hs b/src/Xanthous/Entities/Character.hs
index 5cf397e82232..faa9964a3833 100644
--- a/src/Xanthous/Entities/Character.hs
+++ b/src/Xanthous/Entities/Character.hs
@@ -2,14 +2,14 @@ module Xanthous.Entities.Character
   ( Character(..)
   , mkCharacter
   ) where
-
+--------------------------------------------------------------------------------
 import Xanthous.Prelude
 import Test.QuickCheck
-
+--------------------------------------------------------------------------------
 import Xanthous.Entities
+--------------------------------------------------------------------------------
 
-data Character where
-  Character :: Character
+data Character = Character
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (CoArbitrary, Function)
   deriving Draw via (DrawCharacter "@" Character)
diff --git a/src/Xanthous/Entities/Draw/Util.hs b/src/Xanthous/Entities/Draw/Util.hs
new file mode 100644
index 000000000000..aa6c5fa4fc47
--- /dev/null
+++ b/src/Xanthous/Entities/Draw/Util.hs
@@ -0,0 +1,31 @@
+module Xanthous.Entities.Draw.Util where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+--------------------------------------------------------------------------------
+import Brick.Widgets.Border.Style
+import Brick.Types (Edges(..))
+--------------------------------------------------------------------------------
+
+borderFromEdges :: BorderStyle -> Edges Bool -> Char
+borderFromEdges bstyle edges = ($ bstyle) $ case edges of
+  Edges False False  False False -> const '☐'
+
+  Edges True  False  False False -> bsVertical
+  Edges False True   False False -> bsVertical
+  Edges False False  True  False -> bsHorizontal
+  Edges False False  False True  -> bsHorizontal
+
+  Edges True  True   False False -> bsVertical
+  Edges True  False  True  False -> bsCornerBR
+  Edges True  False  False True  -> bsCornerBL
+
+  Edges False True   True  False -> bsCornerTR
+  Edges False True   False True  -> bsCornerTL
+  Edges False False  True  True  -> bsHorizontal
+
+  Edges False True   True  True  -> bsIntersectT
+  Edges True  False  True  True  -> bsIntersectB
+  Edges True  True   False True  -> bsIntersectL
+  Edges True  True   True  False -> bsIntersectR
+
+  Edges True  True   True  True  -> bsIntersectFull
diff --git a/src/Xanthous/Entities/Environment.hs b/src/Xanthous/Entities/Environment.hs
new file mode 100644
index 000000000000..f5301f94adf2
--- /dev/null
+++ b/src/Xanthous/Entities/Environment.hs
@@ -0,0 +1,26 @@
+module Xanthous.Entities.Environment
+  ( Wall(..)
+  ) where
+--------------------------------------------------------------------------------
+import Xanthous.Prelude
+import Test.QuickCheck
+import Brick (str)
+import Brick.Widgets.Border.Style (unicode)
+--------------------------------------------------------------------------------
+import Xanthous.Entities (Draw(..), entityIs)
+import Xanthous.Entities.Draw.Util
+import Xanthous.Data
+--------------------------------------------------------------------------------
+
+data Wall = Wall
+  deriving stock (Show, Eq, Ord, Generic, Enum)
+  deriving anyclass (CoArbitrary, Function)
+
+instance Arbitrary Wall where
+  arbitrary = pure Wall
+
+instance Draw Wall where
+  drawWithNeighbors neighs _wall =
+    str . pure . borderFromEdges unicode $ wallEdges
+    where
+      wallEdges = any (entityIs @Wall) <$> edges neighs
diff --git a/src/Xanthous/Entities/RawTypes.hs b/src/Xanthous/Entities/RawTypes.hs
index e82cb0c890c7..88087a5dab61 100644
--- a/src/Xanthous/Entities/RawTypes.hs
+++ b/src/Xanthous/Entities/RawTypes.hs
@@ -20,7 +20,7 @@ import Data.Aeson.Generic.DerivingVia
 import Data.Aeson (FromJSON)
 import Data.Word
 
-import Xanthous.Data
+import Xanthous.Entities (EntityChar)
 
 data CreatureType = CreatureType
   { _name :: Text
diff --git a/src/Xanthous/Entities/SomeEntity.hs b/src/Xanthous/Entities/SomeEntity.hs
deleted file mode 100644
index 029247de9b7f..000000000000
--- a/src/Xanthous/Entities/SomeEntity.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE GADTs #-}
-module Xanthous.Entities.SomeEntity
-  ( SomeEntity(..)
-  , downcastEntity
-  ) where
-
-import Xanthous.Prelude
-import Test.QuickCheck (Arbitrary(..))
-import qualified Test.QuickCheck.Gen as Gen
-
-import Xanthous.Entities (Draw(..), Entity)
-import Data.Typeable
-import Xanthous.Entities.Character
-
-data SomeEntity where
-  SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity
-
-instance Show SomeEntity where
-  show (SomeEntity x) = "SomeEntity (" <> show x <> ")"
-
-instance Eq SomeEntity where
-  (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of
-    Just Refl -> a == b
-    _ -> False
-
-instance Arbitrary SomeEntity where
-  arbitrary = Gen.oneof
-    [pure $ SomeEntity Character]
-
-instance Draw SomeEntity where
-  draw (SomeEntity ent) = draw ent
-
-downcastEntity :: (Entity a, Typeable a) => SomeEntity -> Maybe a
-downcastEntity (SomeEntity e) = cast e