Don't walk gormlaks into walls

Because of the way lines are drawn, a specific configuration of
positioning for gormlaks would have them decide they desperately wanted
to walk *inside* a wall, which they would then both fail to do but also
always collide with whenever they tried to go anywhere else.

1 files changed, 18 insertions, 9 deletions

diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs
index f49477a2db23..77314a9aea60 100644
--- a/src/Xanthous/Game/Lenses.hs
+++ b/src/Xanthous/Game/Lenses.hs
@@ -10,6 +10,7 @@ module Xanthous.Game.Lenses
 
     -- * Collisions
   , Collision(..)
+  , entityCollision
   , collisionAt
   ) where
 --------------------------------------------------------------------------------
@@ -93,13 +94,21 @@ data Collision
   deriving stock (Show, Eq, Ord, Generic)
   deriving anyclass (NFData)
 
+entityCollision
+  :: ( MonoFoldable (f SomeEntity)
+    , Foldable f
+    , Element (f SomeEntity) ~ SomeEntity
+    , AsEmpty (f SomeEntity)
+    )
+  => f SomeEntity
+  -> Maybe Collision
+entityCollision Empty = Nothing
+entityCollision ents
+  | any (entityIs @Creature) ents = pure Combat
+  | all (entityIs @Item) ents = Nothing
+  | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door
+  , all (view open) doors = Nothing
+  | otherwise = pure Stop
+
 collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
-collisionAt pos = do
-  ents <- use $ entities . EntityMap.atPosition pos
-  pure $
-    if | null ents -> Nothing
-       | any (entityIs @Creature) ents -> pure Combat
-       | all (entityIs @Item) ents -> Nothing
-       | doors@(_ : _) <- ents ^.. folded . _SomeEntity @Door
-       , all (view open) doors -> Nothing
-       | otherwise -> pure Stop
+collisionAt pos = uses (entities . EntityMap.atPosition pos) entityCollision