diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs | 32 |
1 files changed, 32 insertions, 0 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs new file mode 100644 index 000000000000..ba27e3cbca4e --- /dev/null +++ b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs @@ -0,0 +1,32 @@ +-------------------------------------------------------------------------------- +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 + ] + ] |