diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs | 39 |
1 files changed, 36 insertions, 3 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs index ba27e3cbca4e..a6f8401cf75b 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) + ] + ] ] |