1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
--------------------------------------------------------------------------------
module Xanthous.Entities.CommonSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
import Data.Vector.Lens (toVectorOf)
--------------------------------------------------------------------------------
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"
[ testProperty "items === itemsWithPosition . _2" $ \inv ->
inv ^.. items === inv ^.. itemsWithPosition . _2
, testGroup "removeItemFromPosition" $
let rewield w inv =
let (old, inv') = inv & wielded <<.~ w
in inv' & backpack <>~ toVectorOf (wieldedItems . wieldedItem) old
in [ (Backpack, \item -> backpack %~ (item ^. wieldedItem <|))
, (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)
]
]
]
|
