diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs | 65 |
1 files changed, 0 insertions, 65 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs deleted file mode 100644 index a6f8401cf75b..000000000000 --- a/users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs +++ /dev/null @@ -1,65 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Entities.CommonSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude -import Data.Vector.Lens (toVectorOf) --------------------------------------------------------------------------------- -import Xanthous.Entities.Common --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -newtype OneHand = OneHand Hand - deriving stock Show - -instance Arbitrary OneHand where - arbitrary = OneHand <$> elements [LeftHand, RightHand] - -otherHand :: Hand -> Hand -otherHand LeftHand = RightHand -otherHand RightHand = LeftHand -otherHand BothHands = error "OtherHand BothHands" - -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 <|)) - , (InHand LeftHand, rewield . inLeftHand) - , (InHand RightHand, rewield . inRightHand) - , (InHand 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 - ] - , testGroup "Wielded items" - [ testGroup "wieldInHand" - [ testProperty "puts the item in the hand" $ \w hand item -> - let (_, w') = wieldInHand hand item w - in itemsInHand hand w' === [item] - , testProperty "returns items in both hands when wielding double-handed" - $ \lh rh newItem -> - let w = Hands (Just lh) (Just rh) - (prevItems, _) = wieldInHand BothHands newItem w - in prevItems === [lh, rh] - , testProperty "wielding in one hand leaves the item in the other hand" - $ \(OneHand h) existingItem newItem -> - let (_, w) = wieldInHand h existingItem nothingWielded - (prevItems, w') = wieldInHand (otherHand h) newItem w - in prevItems === [] - .&&. sort (w' ^.. wieldedItems) === sort [existingItem, newItem] - , testProperty "always leaves the same items overall" $ \w hand item -> - let (prevItems, w') = wieldInHand hand item w - in sort (prevItems <> (w' ^.. wieldedItems)) - === sort (item : w ^.. wieldedItems) - ] - ] - ] |