Factor out an "entitiesAtCharacter" lens

Factor an "entitiesAtCharacter" lens from the one-two step of getting
the character position, then getting the entities at that position.

3 files changed, 13 insertions, 8 deletions

diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 202f38e868..1c2fbf86f3 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -167,8 +167,7 @@ handleCommand Drop = do
   selectItemFromInventory_ ["drop", "menu"] Cancellable id
     (say_ ["drop", "nothing"])
     $ \(MenuResult item) -> do
-      charPos <- use characterPosition
-      entities . EntityMap.atPosition charPos %= (SomeEntity item <|)
+      entitiesAtCharacter %= (SomeEntity item <|)
       say ["drop", "dropped"] $ object [ "item" A..= item ]
   continue
 
@@ -277,9 +276,7 @@ handleCommand Save = do
         exitSuccess
 
 handleCommand GoUp = do
-  charPos <- use characterPosition
-  hasStairs <- uses (entities . EntityMap.atPosition charPos)
-              $ elem (SomeEntity UpStaircase)
+  hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase)
   if hasStairs
   then uses levels prevLevel >>= \case
     Just levs' -> levels .= levs'
@@ -291,9 +288,7 @@ handleCommand GoUp = do
   continue
 
 handleCommand GoDown = do
-  charPos <- use characterPosition
-  hasStairs <- uses (entities . EntityMap.atPosition charPos)
-              $ elem (SomeEntity DownStaircase)
+  hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity DownStaircase)
 
   if hasStairs
   then do
diff --git a/src/Xanthous/Game.hs b/src/Xanthous/Game.hs
index a8d096f02f..4ca6688919 100644
--- a/src/Xanthous/Game.hs
+++ b/src/Xanthous/Game.hs
@@ -16,6 +16,7 @@ module Xanthous.Game
   , characterPosition
   , updateCharacterVision
   , characterVisiblePositions
+  , entitiesAtCharacter
 
     -- * Messages
   , MessageHistory(..)
diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs
index 8f6053a5ec..dc886f65c6 100644
--- a/src/Xanthous/Game/Lenses.hs
+++ b/src/Xanthous/Game/Lenses.hs
@@ -10,6 +10,7 @@ module Xanthous.Game.Lenses
   , characterVisiblePositions
   , getInitialState
   , initialStateFromSeed
+  , entitiesAtCharacter
 
     -- * Collisions
   , Collision(..)
@@ -28,6 +29,7 @@ import           Xanthous.Data
 import           Xanthous.Data.Levels
 import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Data.EntityMap.Graphics (visiblePositions)
+import           Xanthous.Data.VectorBag
 import           Xanthous.Entities.Character (Character, mkCharacter)
 import           {-# SOURCE #-} Xanthous.Entities.Entities ()
 --------------------------------------------------------------------------------
@@ -113,3 +115,10 @@ entitiesCollision = join . maximumMay . fmap entityCollision
 
 collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
 collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision
+
+entitiesAtCharacter :: Lens' GameState (VectorBag SomeEntity)
+entitiesAtCharacter = lens getter setter
+  where
+    getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition)
+    setter gs ents = gs
+      & entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents