diff options
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Entities')
4 files changed, 0 insertions, 164 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs deleted file mode 100644 index 734cce1efbbe..000000000000 --- a/users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# OPTIONS_GHC -Wno-type-defaults #-} --------------------------------------------------------------------------------- -module Xanthous.Entities.CharacterSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import Xanthous.Entities.Character -import Xanthous.Util (endoTimes) --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Entities.CharacterSpec" - [ testGroup "Knuckles" - [ testBatch $ monoid @Knuckles mempty - , testGroup "damageKnuckles" - [ testCase "caps at 5" $ - let knuckles' = endoTimes 6 damageKnuckles mempty - in _knuckleDamage knuckles' @?= 5 - ] - ] - ] 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) - ] - ] - ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs deleted file mode 100644 index e23f7faba3a6..000000000000 --- a/users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} --------------------------------------------------------------------------------- -module Xanthous.Entities.RawTypesSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import Data.Interval (Extended(..), (<=..<=)) --------------------------------------------------------------------------------- -import Xanthous.Entities.RawTypes --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Entities.RawTypesSpec" - [ testGroup "CreatureGenerateParams" - [ testGroup "Ord laws" - [ testProperty "comparability" $ \(a :: CreatureGenerateParams) b -> - a <= b || b <= a - , testProperty "transitivity" $ \(a :: CreatureGenerateParams) b c -> - a <= b && b <= c ==> a <= c - , testProperty "reflexivity" $ \(a :: CreatureGenerateParams) -> - a <= a - , testProperty "antisymmetry" $ \(a :: CreatureGenerateParams) b -> - (a <= b && b <= a) == (a == b) - ] - , testGroup "canGenerate" $ - let makeParams minB maxB = - let _levelRange = maybe NegInf Finite minB <=..<= maybe PosInf Finite maxB - _equippedItem = Nothing - in CreatureGenerateParams {..} - in - [ testProperty "no bounds" $ \level -> - let gps = makeParams Nothing Nothing - in canGenerate level gps - , testProperty "min bound" $ \level minB -> - let gps = makeParams (Just minB) Nothing - in canGenerate level gps === (level >= minB) - , testProperty "max bound" $ \level maxB -> - let gps = makeParams Nothing (Just maxB) - in canGenerate level gps === (level <= maxB) - ] - ] - ] diff --git a/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs b/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs deleted file mode 100644 index b6c80be51be7..000000000000 --- a/users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs +++ /dev/null @@ -1,30 +0,0 @@ --- | - -module Xanthous.Entities.RawsSpec (main, test) where - -import Test.Prelude -import Xanthous.Entities.Raws -import Xanthous.Entities.RawTypes - (_Creature, entityName, generateParams, HasEquippedItem (equippedItem)) - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Entities.Raws" - [ testGroup "raws" - [ testCase "are all valid" $ raws `deepseq` pure () - , testCase "all CreatureEquippedItems reference existent entity names" $ - let notFound - = raws - ^.. folded - . _Creature - . generateParams - . _Just - . equippedItem - . _Just - . entityName - . filtered (isNothing . raw) - in null notFound @? ("Some entities weren't found: " <> show notFound) - ] - ] |