tvl-depot/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs

Ignoring revisions in .git-blame-ignore-revs. Click here to bypass and see the normal blame view.

33 lines
1.4 KiB
Haskell
Raw Normal View History

--------------------------------------------------------------------------------
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
]
]