diff options
author | Griffin Smith <grfn@gws.fyi> | 2021-04-11T21·53-0400 |
---|---|---|
committer | glittershark <grfn@gws.fyi> | 2021-04-12T14·45+0000 |
commit | 6266c5d32f9ff651fcfc3a4cc0c68e89da56ca65 (patch) | |
tree | 5be3967585787c4456e17cb29423770217fdcede /users/glittershark/xanthous/test/Xanthous/Data | |
parent | 968effb5dc1a4617a0dceaffc70e986abe300c6e (diff) |
refactor(users/glittershark): Rename to grfn r/2485
Rename my //users directory and all places that refer to glittershark to grfn, including nix references and documentation. This may require some extra attention inside of gerrit's database after it lands to allow me to actually push things. Change-Id: I4728b7ec2c60024392c1c1fa6e0d4a59b3e266fa Reviewed-on: https://cl.tvl.fyi/c/depot/+/2933 Tested-by: BuildkiteCI Reviewed-by: tazjin <mail@tazj.in> Reviewed-by: lukegb <lukegb@tvl.fyi> Reviewed-by: glittershark <grfn@gws.fyi>
Diffstat (limited to 'users/glittershark/xanthous/test/Xanthous/Data')
6 files changed, 0 insertions, 258 deletions
diff --git a/users/glittershark/xanthous/test/Xanthous/Data/EntitiesSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/EntitiesSpec.hs deleted file mode 100644 index e403503743c0..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/EntitiesSpec.hs +++ /dev/null @@ -1,28 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.EntitiesSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Data.Entities --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.Entities" - [ testGroup "Collision" - [ testProperty "JSON round-trip" $ \(c :: Collision) -> - JSON.decode (JSON.encode c) === Just c - , testGroup "JSON encoding examples" - [ testCase "Stop" $ JSON.encode Stop @?= "\"Stop\"" - , testCase "Combat" $ JSON.encode Combat @?= "\"Combat\"" - ] - ] - , testGroup "EntityAttributes" - [ testProperty "JSON round-trip" $ \(ea :: EntityAttributes) -> - JSON.decode (JSON.encode ea) === Just ea - ] - ] diff --git a/users/glittershark/xanthous/test/Xanthous/Data/EntityCharSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/EntityCharSpec.hs deleted file mode 100644 index 9e8024c9d223..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/EntityCharSpec.hs +++ /dev/null @@ -1,18 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.EntityCharSpec where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Data.EntityChar --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.EntityChar" - [ testProperty "JSON round-trip" $ \(ec :: EntityChar) -> - JSON.decode (JSON.encode ec) === Just ec - ] diff --git a/users/glittershark/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs deleted file mode 100644 index fd37548ce864..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs +++ /dev/null @@ -1,57 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.EntityMap.GraphicsSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude -import Data.Aeson --------------------------------------------------------------------------------- -import Xanthous.Game.State -import Xanthous.Data -import Xanthous.Data.EntityMap -import Xanthous.Data.EntityMap.Graphics -import Xanthous.Entities.Environment (Wall(..)) --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.EntityMap.Graphics" - [ testGroup "visiblePositions" - [ testProperty "one step in each cardinal direction is always visible" - $ \pos (Cardinal dir) (Positive r) (wallPositions :: Set Position)-> - pos `notMember` wallPositions ==> - let em = review _EntityMap . map (, Wall) . toList $ wallPositions - em' = em & atPosition (move dir pos) %~ (Wall <|) - poss = visiblePositions pos r em' - in counterexample ("visiblePositions: " <> show poss) - $ move dir pos `member` poss - , testGroup "bugs" - [ testCase "non-contiguous bug 1" - $ let charPos = Position 20 20 - gormlakPos = Position 17 19 - em = insertAt gormlakPos TestEntity - . insertAt charPos TestEntity - $ mempty - visPositions = visiblePositions charPos 12 em - in (gormlakPos `member` visPositions) @? - ( "not (" - <> show gormlakPos <> " `member` " - <> show visPositions - <> ")" - ) - ] - ] - ] - --------------------------------------------------------------------------------- - -data TestEntity = TestEntity - deriving stock (Show, Eq, Ord, Generic) - deriving anyclass (ToJSON, FromJSON, NFData) - -instance Brain TestEntity where - step _ = pure -instance Draw TestEntity -instance Entity TestEntity where - description _ = "" - entityChar _ = "e" diff --git a/users/glittershark/xanthous/test/Xanthous/Data/EntityMapSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/EntityMapSpec.hs deleted file mode 100644 index 7c5cad019616..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/EntityMapSpec.hs +++ /dev/null @@ -1,69 +0,0 @@ -{-# LANGUAGE ApplicativeDo #-} --------------------------------------------------------------------------------- -module Xanthous.Data.EntityMapSpec where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Data.EntityMap -import Xanthous.Data (Positioned(..)) --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = localOption (QuickCheckTests 20) - $ testGroup "Xanthous.Data.EntityMap" - [ testBatch $ monoid @(EntityMap Int) mempty - , testGroup "Deduplicate" - [ testGroup "Semigroup laws" - [ testProperty "associative" $ \(a :: Deduplicate (EntityMap Int)) b c -> - a <> (b <> c) === (a <> b) <> c - ] - ] - , testGroup "Eq laws" - [ testProperty "reflexivity" $ \(em :: EntityMap Int) -> - em == em - , testProperty "symmetric" $ \(em₁ :: EntityMap Int) em₂ -> - (em₁ == em₂) == (em₂ == em₁) - , testProperty "transitive" $ \(em₁ :: EntityMap Int) em₂ em₃ -> - if (em₁ == em₂ && em₂ == em₃) - then (em₁ == em₃) - else True - ] - , testGroup "JSON encoding/decoding" - [ testProperty "round-trips" $ \(em :: EntityMap Int) -> - let em' = JSON.decode (JSON.encode em) - in counterexample (show (em' ^? _Just . lastID, em ^. lastID - , em' ^? _Just . byID == em ^. byID . re _Just - , em' ^? _Just . byPosition == em ^. byPosition . re _Just - , em' ^? _Just . _EntityMap == em ^. _EntityMap . re _Just - )) - $ em' === Just em - , testProperty "Preserves IDs" $ \(em :: EntityMap Int) -> - let Just em' = JSON.decode $ JSON.encode em - in toEIDsAndPositioned em' === toEIDsAndPositioned em - ] - - , localOption (QuickCheckTests 50) - $ testGroup "atPosition" - [ testProperty "setget" $ \pos (em :: EntityMap Int) es -> - view (atPosition pos) (set (atPosition pos) es em) === es - , testProperty "getset" $ \pos (em :: EntityMap Int) -> - set (atPosition pos) (view (atPosition pos) em) em === em - , testProperty "setset" $ \pos (em :: EntityMap Int) es -> - (set (atPosition pos) es . set (atPosition pos) es) em - === - set (atPosition pos) es em - -- testProperty "lens laws" $ \pos -> isLens $ atPosition @Int pos - , testProperty "preserves IDs" $ \(em :: EntityMap Int) e1 e2 p -> - let (eid, em') = insertAtReturningID p e1 em - em'' = em' & atPosition p %~ (e2 <|) - in - counterexample ("em': " <> show em') - . counterexample ("em'': " <> show em'') - $ em'' ^. at eid === Just (Positioned p e1) - ] - ] diff --git a/users/glittershark/xanthous/test/Xanthous/Data/LevelsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/LevelsSpec.hs deleted file mode 100644 index 4e46946a93b0..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/LevelsSpec.hs +++ /dev/null @@ -1,66 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.LevelsSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Util (between) -import Xanthous.Data.Levels --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.Levels" - [ testGroup "current" - [ testProperty "view is extract" $ \(levels :: Levels Int) -> - levels ^. current === extract levels - , testProperty "set replaces current" $ \(levels :: Levels Int) new -> - extract (set current new levels) === new - , testProperty "set extract is id" $ \(levels :: Levels Int) -> - set current (extract levels) levels === levels - , testProperty "set y ∘ set x ≡ set y" $ \(levels :: Levels Int) x y -> - set current y (set current x levels) === set current y levels - ] - , localOption (QuickCheckTests 20) - $ testBatch $ semigroup @(Levels Int) (error "unused", 1 :: Int) - , testGroup "next/prev" - [ testGroup "nextLevel" - [ testProperty "seeks forwards" $ \(levels :: Levels Int) genned -> - (pos . runIdentity . nextLevel (Identity genned) $ levels) - === pos levels + 1 - , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned -> - let levels' = runIdentity . nextLevel (Identity genned) $ levels - in between 0 (length levels') $ pos levels' - , testProperty "extract is total" $ \(levels :: Levels Int) genned -> - let levels' = runIdentity . nextLevel (Identity genned) $ levels - in total $ extract levels' - , testProperty "uses the generated level as the next level" - $ \(levels :: Levels Int) genned -> - let levels' = seek (length levels - 1) levels - levels'' = runIdentity . nextLevel (Identity genned) $ levels' - in counterexample (show levels'') - $ extract levels'' === genned - ] - , testGroup "prevLevel" - [ testProperty "seeks backwards" $ \(levels :: Levels Int) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> pos levels' === pos levels - 1 - , testProperty "maintains the invariant" $ \(levels :: Levels Int) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> property $ between 0 (length levels') $ pos levels' - , testProperty "extract is total" $ \(levels :: Levels Int) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> total $ extract levels' - ] - ] - , testGroup "JSON" - [ testProperty "toJSON/parseJSON round-trip" $ \(levels :: Levels Int) -> - JSON.decode (JSON.encode levels) === Just levels - ] - ] diff --git a/users/glittershark/xanthous/test/Xanthous/Data/NestedMapSpec.hs b/users/glittershark/xanthous/test/Xanthous/Data/NestedMapSpec.hs deleted file mode 100644 index acf7a67268f4..000000000000 --- a/users/glittershark/xanthous/test/Xanthous/Data/NestedMapSpec.hs +++ /dev/null @@ -1,20 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.NestedMapSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import Test.QuickCheck.Instances.Semigroup () --------------------------------------------------------------------------------- -import qualified Xanthous.Data.NestedMap as NM --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.NestedMap" - [ testProperty "insert/lookup" $ \nm ks v -> - let nm' = NM.insert ks v nm - in counterexample ("inserted: " <> show nm') - $ NM.lookup @Map @Int @Int ks nm' === Just (NM.Val v) - ] |