From 632c4280b5c8ad717a7ce7b08c49ad93630c8db4 Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sat, 16 Apr 2022 16:01:04 -0400
Subject: feat(xanthous): Allow selecting hand for wielding

When wielding items, allow selecting which hand the item should be
wielded in.

Currently this has no actual effect on the mechanics of combat - that'll
come next.

Change-Id: Ic289ca2d8fa6f5fc0ad5bd0b012818a3acd8599e
Reviewed-on: https://cl.tvl.fyi/c/depot/+/5470
Reviewed-by: grfn <grfn@gws.fyi>
Autosubmit: grfn <grfn@gws.fyi>
Tested-by: BuildkiteCI
---
 .../xanthous/test/Xanthous/Entities/CommonSpec.hs  | 39 ++++++++++++++++++++--
 1 file changed, 36 insertions(+), 3 deletions(-)

(limited to 'users/grfn/xanthous/test/Xanthous')

diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs
index ba27e3cbca..a6f8401cf7 100644
--- a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs
+++ b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs
@@ -10,6 +10,17 @@ import           Xanthous.Entities.Common
 main :: IO ()
 main = defaultMain test
 
+newtype OneHand = OneHand Hand
+  deriving stock Show
+
+instance Arbitrary OneHand where
+  arbitrary = OneHand <$> elements [LeftHand, RightHand]
+
+otherHand :: Hand -> Hand
+otherHand LeftHand = RightHand
+otherHand RightHand = LeftHand
+otherHand BothHands = error "OtherHand BothHands"
+
 test :: TestTree
 test = testGroup "Xanthous.Entities.CommonSpec"
   [ testGroup "Inventory"
@@ -20,13 +31,35 @@ test = testGroup "Xanthous.Entities.CommonSpec"
             let (old, inv') = inv & wielded <<.~ w
             in inv' & backpack <>~ toVectorOf (wieldedItems . wieldedItem) old
       in [ (Backpack, \item -> backpack %~ (item ^. wieldedItem <|))
-         , (LeftHand, rewield . inLeftHand)
-         , (RightHand, rewield . inRightHand)
-         , (BothHands, rewield . review doubleHanded)
+         , (InHand LeftHand, rewield . inLeftHand)
+         , (InHand RightHand, rewield . inRightHand)
+         , (InHand BothHands, rewield . review doubleHanded)
          ] <&> \(pos, addItem) ->
            testProperty (show pos) $ \inv item ->
              let inv' = addItem item inv
                  inv'' = removeItemFromPosition pos (item ^. wieldedItem) inv'
              in inv'' ^.. items === inv ^.. items
     ]
+  , testGroup "Wielded items"
+    [ testGroup "wieldInHand"
+      [ testProperty "puts the item in the hand" $ \w hand item ->
+          let (_, w') = wieldInHand hand item w
+          in itemsInHand hand w' === [item]
+      , testProperty "returns items in both hands when wielding double-handed"
+        $ \lh rh newItem ->
+          let w = Hands (Just lh) (Just rh)
+              (prevItems, _) = wieldInHand BothHands newItem w
+          in prevItems === [lh, rh]
+      , testProperty "wielding in one hand leaves the item in the other hand"
+        $ \(OneHand h) existingItem newItem ->
+          let (_, w) = wieldInHand h existingItem nothingWielded
+              (prevItems, w') = wieldInHand (otherHand h) newItem w
+          in   prevItems === []
+          .&&. sort (w' ^.. wieldedItems) === sort [existingItem, newItem]
+      , testProperty "always leaves the same items overall" $ \w hand item ->
+          let (prevItems, w') = wieldInHand hand item w
+          in  sort (prevItems <> (w' ^.. wieldedItems))
+          === sort (item : w ^.. wieldedItems)
+      ]
+    ]
   ]
-- 
cgit 1.4.1