From 95ee86225b7b858ae6c2438211e934ee4db66222 Mon Sep 17 00:00:00 2001 From: Griffin Smith Date: Sun, 21 Nov 2021 09:54:07 -0500 Subject: refactor(gs/xanthous): Break out inventory into a common module Creatures are going to have an inventory too now in addition to characters, so all the data types and lenses and stuff that define inventory need to be broken out into a separate module so the Creature entity can use them. Change-Id: I83f1c70d316afaaf2e75901f9dc28f79fd2cd31f Reviewed-on: https://cl.tvl.fyi/c/depot/+/3901 Tested-by: BuildkiteCI Reviewed-by: grfn --- users/grfn/xanthous/test/Spec.hs | 2 ++ .../test/Xanthous/Entities/CharacterSpec.hs | 18 ------------ .../xanthous/test/Xanthous/Entities/CommonSpec.hs | 32 ++++++++++++++++++++++ 3 files changed, 34 insertions(+), 18 deletions(-) create mode 100644 users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs (limited to 'users/grfn/xanthous/test') diff --git a/users/grfn/xanthous/test/Spec.hs b/users/grfn/xanthous/test/Spec.hs index 80826053866a..64c10cf21e20 100644 --- a/users/grfn/xanthous/test/Spec.hs +++ b/users/grfn/xanthous/test/Spec.hs @@ -9,6 +9,7 @@ import qualified Xanthous.Data.LevelsSpec import qualified Xanthous.Data.MemoSpec import qualified Xanthous.Data.NestedMapSpec import qualified Xanthous.DataSpec +import qualified Xanthous.Entities.CommonSpec import qualified Xanthous.Entities.RawsSpec import qualified Xanthous.Entities.RawTypesSpec import qualified Xanthous.Entities.CharacterSpec @@ -38,6 +39,7 @@ test = testGroup "Xanthous" , Xanthous.Data.MemoSpec.test , Xanthous.Data.NestedMapSpec.test , Xanthous.DataSpec.test + , Xanthous.Entities.CommonSpec.test , Xanthous.Entities.RawsSpec.test , Xanthous.Entities.CharacterSpec.test , Xanthous.Entities.RawTypesSpec.test 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 + ] + ] -- cgit 1.4.1