about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Entities/Common.hs')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Common.hs72
1 files changed, 56 insertions, 16 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
index becd1b1ef62e..368b03f25bed 100644
--- a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
+++ b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
@@ -20,12 +20,18 @@ module Xanthous.Entities.Common
 
     -- ** Wielded items
   , Wielded(..)
+  , nothingWielded
   , hands
   , leftHand
   , rightHand
   , inLeftHand
   , inRightHand
   , doubleHanded
+  , Hand(..)
+  , itemsInHand
+  , inHand
+  , wieldInHand
+  , describeHand
   , wieldedItems
   , WieldedItem(..)
   , wieldedItem
@@ -95,6 +101,7 @@ data Wielded
        via WithOptions '[ 'SumEnc 'ObjWithSingleField ]
            Wielded
 
+
 nothingWielded :: Wielded
 nothingWielded = Hands Nothing Nothing
 
@@ -124,6 +131,43 @@ wieldedItems :: Traversal' Wielded WieldedItem
 wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded
 wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r
 
+
+data Hand
+  = LeftHand
+  | RightHand
+  | BothHands
+  deriving stock (Eq, Show, Ord, Generic)
+  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving Arbitrary via GenericArbitrary Hand
+
+itemsInHand :: Hand -> Wielded -> [WieldedItem]
+itemsInHand LeftHand (DoubleHanded wi) = [wi]
+itemsInHand LeftHand (Hands lh _) = toList lh
+itemsInHand RightHand (DoubleHanded wi) = [wi]
+itemsInHand RightHand (Hands _ rh) = toList rh
+itemsInHand BothHands (DoubleHanded wi) = [wi]
+itemsInHand BothHands (Hands lh rh) = toList lh <> toList rh
+
+inHand :: Hand -> WieldedItem -> Wielded
+inHand LeftHand = inLeftHand
+inHand RightHand = inRightHand
+inHand BothHands = review doubleHanded
+
+wieldInHand :: Hand -> WieldedItem -> Wielded -> ([WieldedItem], Wielded)
+wieldInHand hand item w = (itemsInHand hand w, doWield)
+  where
+    doWield = case (hand, w) of
+      (LeftHand, Hands _ r) -> Hands (Just item) r
+      (LeftHand, DoubleHanded _) -> inLeftHand item
+      (RightHand, Hands l _) -> Hands l (Just item)
+      (RightHand, DoubleHanded _) -> inRightHand item
+      (BothHands, _) -> DoubleHanded item
+
+describeHand :: Hand -> Text
+describeHand LeftHand = "your left hand"
+describeHand RightHand = "your right hand"
+describeHand BothHands = "both hands"
+
 data Inventory = Inventory
   { _backpack :: Vector Item
   , _wielded :: Wielded
@@ -199,27 +243,23 @@ class HasInventory s a | s -> a where
 -- | Representation for where in the inventory an item might be
 data InventoryPosition
   = Backpack
-  | LeftHand
-  | RightHand
-  | BothHands
+  | InHand Hand
   deriving stock (Eq, Show, Ord, Generic)
   deriving anyclass (NFData, CoArbitrary, Function)
   deriving Arbitrary via GenericArbitrary InventoryPosition
 
 -- | Return a human-readable description of the given 'InventoryPosition'
 describeInventoryPosition :: InventoryPosition -> Text
-describeInventoryPosition Backpack  = "In backpack"
-describeInventoryPosition LeftHand  = "Wielded, in left hand"
-describeInventoryPosition RightHand = "Wielded, in right hand"
-describeInventoryPosition BothHands = "Wielded, in both hands"
+describeInventoryPosition Backpack       = "In backpack"
+describeInventoryPosition (InHand hand)  = "Wielded, in " <> describeHand hand
 
 -- | Given a position in the inventory, return a traversal on the inventory over
 -- all the items in that position
 inventoryPosition :: InventoryPosition -> Traversal' Inventory Item
 inventoryPosition Backpack = backpack . traversed
-inventoryPosition LeftHand = wielded . leftHand . _Just . wieldedItem
-inventoryPosition RightHand = wielded . leftHand . _Just . wieldedItem
-inventoryPosition BothHands = wielded . doubleHanded . wieldedItem
+inventoryPosition (InHand LeftHand) = wielded . leftHand . _Just . wieldedItem
+inventoryPosition (InHand RightHand) = wielded . leftHand . _Just . wieldedItem
+inventoryPosition (InHand BothHands) = wielded . doubleHanded . wieldedItem
 
 -- | A fold over all the items in the inventory accompanied by their position in
 -- the inventory
@@ -230,20 +270,20 @@ itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems
   where
     backpackItems = toListOf $ backpack . folded . to (Backpack ,)
     handItems inv = case inv ^. wielded of
-       DoubleHanded i -> pure (BothHands, i ^. wieldedItem)
-       Hands l r -> (l ^.. folded . wieldedItem . to (LeftHand ,))
-                 <> (r ^.. folded . wieldedItem . to (RightHand ,))
+       DoubleHanded i -> pure (InHand BothHands, i ^. wieldedItem)
+       Hands l r -> (l ^.. folded . wieldedItem . to (InHand LeftHand ,))
+                 <> (r ^.. folded . wieldedItem . to (InHand RightHand ,))
 
 -- | Remove the first item equal to 'Item' from the given position in the
 -- inventory
 removeItemFromPosition :: InventoryPosition -> Item -> Inventory -> Inventory
 removeItemFromPosition Backpack item inv
   = inv & backpack %~ removeFirst (== item)
-removeItemFromPosition LeftHand item inv
+removeItemFromPosition (InHand LeftHand) item inv
   = inv & wielded . leftHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition RightHand item inv
+removeItemFromPosition (InHand RightHand) item inv
   = inv & wielded . rightHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition BothHands item inv
+removeItemFromPosition (InHand BothHands) item inv
   | has (wielded . doubleHanded . wieldedItem . filtered (== item)) inv
   = inv & wielded .~ nothingWielded
   | otherwise