diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Entities')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs | 18 | ||||
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs | 32 |
2 files changed, 32 insertions, 18 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs index 9210355d2dbb..734cce1efbbe 100644 --- a/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs +++ b/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs @@ -3,7 +3,6 @@ module Xanthous.Entities.CharacterSpec (main, test) where -------------------------------------------------------------------------------- import Test.Prelude -import Data.Vector.Lens (toVectorOf) -------------------------------------------------------------------------------- import Xanthous.Entities.Character import Xanthous.Util (endoTimes) @@ -22,21 +21,4 @@ test = testGroup "Xanthous.Entities.CharacterSpec" 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 - ] ] 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 + ] + ] |