33 lines
1.4 KiB
Haskell
33 lines
1.4 KiB
Haskell
|
--------------------------------------------------------------------------------
|
||
|
|
module Xanthous.Entities.CommonSpec (main, test) where
|
||
|
|
--------------------------------------------------------------------------------
|
||
|
|
import Test.Prelude
|
||
|
|
import Data.Vector.Lens (toVectorOf)
|
||
|
|
--------------------------------------------------------------------------------
|
||
|
|
import Xanthous.Entities.Common
|
||
|
|
--------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = defaultMain test
|
||
|
|
|
||
|
|
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 <|))
|
||
|
|
, (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
|
||
|
|
]
|
||
|
|
]
|