From 9256c976edec462af26f33317df6171045e68aa5 Mon Sep 17 00:00:00 2001
From: Griffin Smith <root@gws.fyi>
Date: Sat, 25 Jan 2020 11:18:32 -0500
Subject: 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.
---
 src/Xanthous/App.hs         | 11 +++--------
 src/Xanthous/Game.hs        |  1 +
 src/Xanthous/Game/Lenses.hs |  9 +++++++++
 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
-- 
cgit 1.4.1