feat(xanthous): Add a command to describe an item in the inventory r/2680

Add a new DescribeInventory command, bound to I, to prompt for an item
in the inventory (anywhere in the inventory, including wielded) and
display a (new) panel describing it in detail. This description includes
the description, the long description, and the item's physical
properties (volume, density, and weight).

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

1 files changed, 55 insertions, 15 deletions

diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs
index 6ed545e3aa4f..f43b7e58fc91 100644
--- a/users/grfn/xanthous/src/Xanthous/App.hs
+++ b/users/grfn/xanthous/src/Xanthous/App.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE RecordWildCards      #-}
 --------------------------------------------------------------------------------
+{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
 module Xanthous.App
   ( makeApp
   , RunType(..)
@@ -19,6 +20,7 @@ import qualified Data.Vector as V
 import           System.Exit
 import           System.Directory (doesFileExist)
 import           Data.List.NonEmpty (NonEmpty(..))
+import           Data.Vector.Lens (toVectorOf)
 --------------------------------------------------------------------------------
 import           Xanthous.App.Common
 import           Xanthous.App.Time
@@ -151,7 +153,7 @@ handleCommand PickUp = do
       stepGameBy 100 -- TODO
 
 handleCommand Drop = do
-  selectItemFromInventory_ ["drop", "menu"] Cancellable id
+  takeItemFromInventory_ ["drop", "menu"] Cancellable id
     (say_ ["drop", "nothing"])
     $ \(MenuResult item) -> do
       entitiesAtCharacter %= (SomeEntity item <|)
@@ -271,8 +273,16 @@ handleCommand Read = do
 
 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
+  continue
+
+
 handleCommand Wield = do
-  selectItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem
+  takeItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem
     (say_ ["wield", "nothing"])
     $ \(MenuResult item) -> do
       prevItems <- character . inventory . wielded <<.= inRightHand item
@@ -403,8 +413,8 @@ entityMenuChar entity
         then ec
         else 'a'
 
--- | Prompt with an item to select out of the inventory, remove it from the
--- inventory, and call callback with it
+-- | Prompt with an item to select out of the inventory and call callback with
+-- it
 selectItemFromInventory
   :: forall item params.
     (ToJSON params)
@@ -417,23 +427,21 @@ selectItemFromInventory
   -> AppM ()            -- ^ Action to take if there are no items matching
   -> (PromptResult ('Menu item) -> AppM ())
   -> AppM ()
-selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb =
-  uses (character . inventory . backpack)
-       (V.mapMaybe $ preview extraInfo)
+selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = do
+  uses (character . inventory)
+       (V.mapMaybe (preview extraInfo) . toVectorOf items)
     >>= \case
       Empty -> onEmpty
-      items' ->
-        menu msgPath msgParams cancellable (itemMenu items')
-        $ \(MenuResult (idx, item)) -> do
-          character . inventory . backpack %= removeVectorIndex idx
-          cb $ MenuResult item
+      items' -> menu msgPath msgParams cancellable (itemMenu items') cb
   where
-    itemMenu = mkMenuItems . imap itemMenuItem
-    itemMenuItem idx extraInfoItem =
+    itemMenu = mkMenuItems . map itemMenuItem
+    itemMenuItem extraInfoItem =
       let item = extraInfo # extraInfoItem
       in ( entityMenuChar item
-         , MenuOption (description item) (idx, extraInfoItem))
+         , MenuOption (description item) extraInfoItem)
 
+-- | Prompt with an item to select out of the inventory and call callback with
+-- it
 selectItemFromInventory_
   :: forall item.
     [Text]            -- ^ Menu message
@@ -446,6 +454,38 @@ selectItemFromInventory_
   -> AppM ()
 selectItemFromInventory_ msgPath = selectItemFromInventory msgPath ()
 
+-- | Prompt with an item to select out of the inventory, remove it from the
+-- inventory, and call callback with it
+takeItemFromInventory
+  :: forall item params.
+    (ToJSON params)
+  => [Text]            -- ^ Menu message
+  -> params            -- ^ Menu message params
+  -> PromptCancellable -- ^ Is the menu cancellable?
+  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
+                      --   recoverable fashion. Prism vs iso so we can discard
+                      --   items.
+  -> AppM ()            -- ^ Action to take if there are no items matching
+  -> (PromptResult ('Menu item) -> AppM ())
+  -> AppM ()
+takeItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb =
+  selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty
+    $ \(MenuResult item) -> do
+      character . inventory . backpack %= filter (/= (item ^. re extraInfo))
+      cb $ MenuResult item
+
+takeItemFromInventory_
+  :: forall item.
+    [Text]            -- ^ Menu message
+  -> PromptCancellable -- ^ Is the menu cancellable?
+  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
+                      --   recoverable fashion. Prism vs iso so we can discard
+                      --   items.
+  -> AppM ()            -- ^ Action to take if there are no items matching
+  -> (PromptResult ('Menu item) -> AppM ())
+  -> AppM ()
+takeItemFromInventory_ msgPath = takeItemFromInventory msgPath ()
+
 -- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
 -- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity