diff options
author | Aspen Smith <grfn@gws.fyi> | 2024-02-12T03·00-0500 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2024-02-14T19·37+0000 |
commit | 82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 (patch) | |
tree | 429c5e078528000591742ec3211bc768ae913a78 /users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs | |
parent | 0ba476a4266015f278f18d74094299de74a5a111 (diff) |
chore(users): grfn -> aspen r/7511
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
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) - ] - ] - ] |