blob: 9210355d2dbbd3031682e12180691a18577fcb33 (
plain) (
blame)
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
|
{-# OPTIONS_GHC -Wno-type-defaults #-}
--------------------------------------------------------------------------------
module Xanthous.Entities.CharacterSpec (main, test) where
--------------------------------------------------------------------------------
import Test.Prelude
import Data.Vector.Lens (toVectorOf)
--------------------------------------------------------------------------------
import Xanthous.Entities.Character
import Xanthous.Util (endoTimes)
--------------------------------------------------------------------------------
main :: IO ()
main = defaultMain test
test :: TestTree
test = testGroup "Xanthous.Entities.CharacterSpec"
[ testGroup "Knuckles"
[ testBatch $ monoid @Knuckles mempty
, testGroup "damageKnuckles"
[ testCase "caps at 5" $
let knuckles' = endoTimes 6 damageKnuckles mempty
in _knuckleDamage knuckles' @?= 5
]
]
, 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 <|))
, (LeftHand, rewield . inLeftHand)
, (RightHand, rewield . inRightHand)
, (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
]
]
|
