feat(xanthous): Describe *where* the item is in the inventory r/2681

When describing items in the inventory, both in detail and when
producing menus from those items, describe not just the item itself but
also *where* in the inventory the item is (either in the backpack, or
wielded in either or both of the hands). This uses a new
InventoryPosition datatype, and a method to get a list of items in the
inventory associated with their inventory position. When *removing*
items from the inventory (to wield, drop, or eat them), we want to make
sure we remove from the right position, so this also introduces
a `removeItemAtPosition` method to make that happen correctly.

Finally, some of the tests for this stuff was getting really slow - I
narrowed this down to runaway arbitrary generation for message
Templates, so I've tweaked the Arbitrary instance for that type to
generate smaller values.

Change-Id: I24e9948adae24b0ca9bf13955602108ca9079dcc
Reviewed-on: https://cl.tvl.fyi/c/depot/+/3228
Reviewed-by: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI

1 files changed, 14 insertions, 9 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs
index f43b7e58fc..8c5cffc9f8 100644
--- a/users/grfn/xanthous/src/Xanthous/App.hs
+++ b/users/grfn/xanthous/src/Xanthous/App.hs
@@ -276,8 +276,9 @@ handleCommand ShowInventory = showPanel InventoryPanel >> continue
 handleCommand DescribeInventory = do
   selectItemFromInventory_ ["inventory", "describe", "select"] Cancellable id
     (say_ ["inventory", "describe", "nothing"])
-    $ \(MenuResult item) ->
-        showPanel . ItemDescriptionPanel $ Item.fullDescription item
+    $ \(MenuResult (invPos, item)) -> showPanel . ItemDescriptionPanel
+        $ Item.fullDescription item
+        <> "\n\n" <> describeInventoryPosition invPos
   continue
 
 
@@ -425,20 +426,23 @@ selectItemFromInventory
                       --   recoverable fashion. Prism vs iso so we can discard
                       --   items.
   -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu item) -> AppM ())
+  -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ())
   -> AppM ()
 selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = do
   uses (character . inventory)
-       (V.mapMaybe (preview extraInfo) . toVectorOf items)
+       (V.mapMaybe (_2 $ preview extraInfo) . toVectorOf itemsWithPosition)
     >>= \case
       Empty -> onEmpty
       items' -> menu msgPath msgParams cancellable (itemMenu items') cb
   where
     itemMenu = mkMenuItems . map itemMenuItem
-    itemMenuItem extraInfoItem =
+    itemMenuItem (invPos, extraInfoItem) =
       let item = extraInfo # extraInfoItem
       in ( entityMenuChar item
-         , MenuOption (description item) extraInfoItem)
+         , MenuOption
+           (description item <> " (" <> describeInventoryPosition invPos <> ")")
+           (invPos, extraInfoItem)
+         )
 
 -- | Prompt with an item to select out of the inventory and call callback with
 -- it
@@ -450,7 +454,7 @@ selectItemFromInventory_
                       --   recoverable fashion. Prism vs iso so we can discard
                       --   items.
   -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu item) -> AppM ())
+  -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ())
   -> AppM ()
 selectItemFromInventory_ msgPath = selectItemFromInventory msgPath ()
 
@@ -470,8 +474,9 @@ takeItemFromInventory
   -> AppM ()
 takeItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb =
   selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty
-    $ \(MenuResult item) -> do
-      character . inventory . backpack %= filter (/= (item ^. re extraInfo))
+    $ \(MenuResult (invPos, item)) -> do
+      character . inventory
+        %= removeItemFromPosition invPos (item ^. re extraInfo)
       cb $ MenuResult item
 
 takeItemFromInventory_