about summary refs log tree commit diff
path: root/users/glittershark/xanthous/test
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark/xanthous/test')
-rw-r--r--users/glittershark/xanthous/test/Spec.hs47
-rw-r--r--users/glittershark/xanthous/test/Test/Prelude.hs19
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/EntitiesSpec.hs28
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/EntityCharSpec.hs18
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs57
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/EntityMapSpec.hs69
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/LevelsSpec.hs66
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Data/NestedMapSpec.hs20
-rw-r--r--users/glittershark/xanthous/test/Xanthous/DataSpec.hs98
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Entities/RawsSpec.hs16
-rw-r--r--users/glittershark/xanthous/test/Xanthous/GameSpec.hs55
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs84
-rw-r--r--users/glittershark/xanthous/test/Xanthous/MessageSpec.hs53
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs80
-rw-r--r--users/glittershark/xanthous/test/Xanthous/OrphansSpec.hs42
-rw-r--r--users/glittershark/xanthous/test/Xanthous/RandomSpec.hs25
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs39
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs72
-rw-r--r--users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs18
-rw-r--r--users/glittershark/xanthous/test/Xanthous/UtilSpec.hs28
20 files changed, 0 insertions, 934 deletions
diff --git a/users/glittershark/xanthous/test/Spec.hs b/users/glittershark/xanthous/test/Spec.hs
deleted file mode 100644
index f15c393ac917..000000000000
--- a/users/glittershark/xanthous/test/Spec.hs
+++ /dev/null
@@ -1,47 +0,0 @@
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import qualified Xanthous.Data.EntitiesSpec
-import qualified Xanthous.Data.EntityCharSpec
-import qualified Xanthous.Data.EntityMap.GraphicsSpec
-import qualified Xanthous.Data.EntityMapSpec
-import qualified Xanthous.Data.LevelsSpec
-import qualified Xanthous.Data.NestedMapSpec
-import qualified Xanthous.DataSpec
-import qualified Xanthous.Entities.RawsSpec
-import qualified Xanthous.GameSpec
-import qualified Xanthous.Generators.UtilSpec
-import qualified Xanthous.MessageSpec
-import qualified Xanthous.Messages.TemplateSpec
-import qualified Xanthous.OrphansSpec
-import qualified Xanthous.RandomSpec
-import qualified Xanthous.Util.GraphSpec
-import qualified Xanthous.Util.GraphicsSpec
-import qualified Xanthous.Util.InflectionSpec
-import qualified Xanthous.UtilSpec
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous"
-  [ Xanthous.Data.EntitiesSpec.test
-  , Xanthous.Data.EntityMap.GraphicsSpec.test
-  , Xanthous.Data.EntityMapSpec.test
-  , Xanthous.Data.LevelsSpec.test
-  , Xanthous.Data.NestedMapSpec.test
-  , Xanthous.DataSpec.test
-  , Xanthous.Entities.RawsSpec.test
-  , Xanthous.GameSpec.test
-  , Xanthous.Generators.UtilSpec.test
-  , Xanthous.MessageSpec.test
-  , Xanthous.Messages.TemplateSpec.test
-  , Xanthous.OrphansSpec.test
-  , Xanthous.RandomSpec.test
-  , Xanthous.Util.GraphSpec.test
-  , Xanthous.Util.GraphicsSpec.test
-  , Xanthous.Util.InflectionSpec.test
-  , Xanthous.UtilSpec.test
-  , Xanthous.Data.EntityCharSpec.test
-  ]
diff --git a/users/glittershark/xanthous/test/Test/Prelude.hs b/users/glittershark/xanthous/test/Test/Prelude.hs
deleted file mode 100644
index c423796184f7..000000000000
--- a/users/glittershark/xanthous/test/Test/Prelude.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module Test.Prelude
-  ( module Xanthous.Prelude
-  , module Test.Tasty
-  , module Test.Tasty.HUnit
-  , module Test.Tasty.QuickCheck
-  , module Test.QuickCheck.Classes
-  , testBatch
-  ) where
-
-import Xanthous.Prelude hiding (assert, elements)
-import Test.Tasty
-import Test.Tasty.QuickCheck
-import Test.Tasty.HUnit
-import Test.QuickCheck.Classes
-import Test.QuickCheck.Checkers (TestBatch)
-import Test.QuickCheck.Instances.ByteString ()
-
-testBatch :: TestBatch -> TestTree
-testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests
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)
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/DataSpec.hs b/users/glittershark/xanthous/test/Xanthous/DataSpec.hs
deleted file mode 100644
index 91dc6cea1ba5..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/DataSpec.hs
+++ /dev/null
@@ -1,98 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.DataSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude hiding (Right, Left, Down, toList, all)
-import Data.Group
-import Data.Foldable (toList, all)
---------------------------------------------------------------------------------
-import Xanthous.Data
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Data"
-  [ testGroup "Position"
-    [ testBatch $ monoid @Position mempty
-    , testProperty "group laws" $ \(pos :: Position) ->
-        pos <> invert pos == mempty && invert pos <> pos == mempty
-    , testGroup "stepTowards laws"
-      [ testProperty "takes only one step" $ \src tgt ->
-          src /= tgt ==>
-            isUnit (src `diffPositions` (src `stepTowards` tgt))
-      -- , testProperty "moves in the right direction" $ \src tgt ->
-      --     stepTowards src tgt == move (directionOf src tgt) src
-      ]
-    , testProperty "directionOf laws" $ \pos dir ->
-        directionOf pos (move dir pos) == dir
-    , testProperty "diffPositions is add inverse" $ \(pos₁ :: Position) pos₂ ->
-        diffPositions pos₁ pos₂ == addPositions pos₁ (invert pos₂)
-    , testGroup "isUnit"
-      [ testProperty "double direction is never unit" $ \dir ->
-          not . isUnit $ move dir (asPosition dir)
-      , testCase "examples" $ do
-          isUnit (Position @Int 1 1) @? "not . isUnit $ Position 1 1"
-          isUnit (Position @Int 0 (-1)) @? "not . isUnit $ Position 0 (-1)"
-          (not . isUnit) (Position @Int 1 13) @? "isUnit $ Position 1 13"
-      ]
-    ]
-
-  , testGroup "Direction"
-    [ testProperty "opposite is involutive" $ \(dir :: Direction) ->
-        opposite (opposite dir) == dir
-    , testProperty "opposite provides inverse" $ \dir ->
-        invert (asPosition dir) === asPosition (opposite dir)
-    , testProperty "asPosition isUnit" $ \dir ->
-        dir /= Here ==> isUnit (asPosition dir)
-    , testGroup "Move"
-      [ testCase "Up"        $ move Up mempty        @?= Position @Int 0 (-1)
-      , testCase "Down"      $ move Down mempty      @?= Position @Int 0 1
-      , testCase "Left"      $ move Left mempty      @?= Position @Int (-1) 0
-      , testCase "Right"     $ move Right mempty     @?= Position @Int 1 0
-      , testCase "UpLeft"    $ move UpLeft mempty    @?= Position @Int (-1) (-1)
-      , testCase "UpRight"   $ move UpRight mempty   @?= Position @Int 1 (-1)
-      , testCase "DownLeft"  $ move DownLeft mempty  @?= Position @Int (-1) 1
-      , testCase "DownRight" $ move DownRight mempty @?= Position @Int 1 1
-      ]
-    ]
-
-  , testGroup "Corner"
-    [ testGroup "instance Opposite"
-      [ testProperty "involutive" $ \(corner :: Corner) ->
-          opposite (opposite corner) === corner
-      ]
-    ]
-
-  , testGroup "Edge"
-    [ testGroup "instance Opposite"
-      [ testProperty "involutive" $ \(edge :: Edge) ->
-          opposite (opposite edge) === edge
-      ]
-    ]
-
-  , testGroup "Box"
-    [ testGroup "boxIntersects"
-      [ testProperty "True" $ \dims ->
-          boxIntersects (Box @Word (V2 1 1) (V2 2 2))
-                        (Box (V2 2 2) dims)
-      , testProperty "False" $ \dims ->
-          not $ boxIntersects (Box @Word (V2 1 1) (V2 2 2))
-                            (Box (V2 4 2) dims)
-      ]
-    ]
-
-  , testGroup "Neighbors"
-    [ testGroup "rotations"
-      [ testProperty "always has the same members"
-        $ \(neighs :: Neighbors Int) ->
-          all (\ns -> sort (toList ns) == sort (toList neighs))
-          $ rotations neighs
-      , testProperty "all rotations have the same rotations"
-        $ \(neighs :: Neighbors Int) ->
-          let rots = rotations neighs
-          in all (\ns -> sort (toList $ rotations ns) == sort (toList rots))
-             rots
-      ]
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/Entities/RawsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Entities/RawsSpec.hs
deleted file mode 100644
index 2e6f35457fc7..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Entities/RawsSpec.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- |
-
-module Xanthous.Entities.RawsSpec (main, test) where
-
-import Test.Prelude
-import Xanthous.Entities.Raws
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Entities.Raws"
-  [ testGroup "raws"
-    [ testCase "are all valid" $ raws `deepseq` pure ()
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/GameSpec.hs b/users/glittershark/xanthous/test/Xanthous/GameSpec.hs
deleted file mode 100644
index 2fa8527d0e59..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/GameSpec.hs
+++ /dev/null
@@ -1,55 +0,0 @@
-module Xanthous.GameSpec where
-
-import Test.Prelude hiding (Down)
-import Xanthous.Game
-import Xanthous.Game.State
-import Control.Lens.Properties
-import Xanthous.Data (move, Direction(Down))
-import Xanthous.Data.EntityMap (atPosition)
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test
-  = localOption (QuickCheckTests 10)
-  . localOption (QuickCheckMaxSize 10)
-  $ testGroup "Xanthous.Game"
-  [ testGroup "positionedCharacter"
-    [ testProperty "lens laws" $ isLens positionedCharacter
-    , testCase "updates the position of the character" $ do
-      initialGame <- getInitialState
-      let initialPos = initialGame ^. characterPosition
-          updatedGame = initialGame & characterPosition %~ move Down
-          updatedPos = updatedGame ^. characterPosition
-      updatedPos @?= move Down initialPos
-      updatedGame ^. entities . atPosition initialPos @?= fromList []
-      updatedGame ^. entities . atPosition updatedPos
-        @?= fromList [SomeEntity $ initialGame ^. character]
-    ]
-  , testGroup "characterPosition"
-    [ testProperty "lens laws" $ isLens characterPosition
-    ]
-  , testGroup "character"
-    [ testProperty "lens laws" $ isLens character
-    ]
-  , testGroup "MessageHistory"
-    [ testGroup "MonoComonad laws"
-      [ testProperty "oextend oextract ≡ id"
-        $ \(mh :: MessageHistory) -> oextend oextract mh === mh
-      , testProperty "oextract ∘ oextend f ≡ f"
-        $ \(mh :: MessageHistory) f -> (oextract . oextend f) mh === f mh
-      , testProperty "oextend f ∘ oextend g ≡ oextend (f . oextend g)"
-        $ \(mh :: MessageHistory) f g ->
-          (oextend f . oextend g) mh === oextend (f . oextend g) mh
-      ]
-    ]
-  , testGroup "Saving the game"
-    [ testProperty "forms a prism" $ isPrism saved
-    , testProperty "round-trips" $ \gs ->
-        loadGame (saveGame gs) === Just gs
-    , testProperty "preserves the character ID" $ \gs ->
-        let Just gs' = loadGame $ saveGame gs
-        in gs' ^. character === gs ^. character
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
deleted file mode 100644
index cdfadc06f505..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Generators/UtilSpec.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-{-# LANGUAGE PackageImports #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.UtilSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
-import System.Random (mkStdGen)
-import Control.Monad.Random (runRandT)
-import Data.Array.ST (STUArray, runSTUArray, thaw)
-import Data.Array.IArray (bounds)
-import Data.Array.MArray (newArray, readArray, writeArray)
-import Data.Array (Array, range, listArray, Ix)
-import Control.Monad.ST (ST, runST)
-import "checkers" Test.QuickCheck.Instances.Array ()
-import Linear.V2
---------------------------------------------------------------------------------
-import Xanthous.Util
-import Xanthous.Data (width, height)
-import Xanthous.Generators.Util
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
---------------------------------------------------------------------------------
-
-newtype GenArray a b = GenArray (Array a b)
-  deriving stock (Show, Eq)
-
-instance (Ix a, Arbitrary a, CoArbitrary a, Arbitrary b)
-       => Arbitrary (GenArray a b) where
-  arbitrary = GenArray <$> do
-    (mkElem :: a -> b) <- arbitrary
-    minDims <- arbitrary
-    maxDims <- arbitrary
-    let bnds = (minDims, maxDims)
-    pure $ listArray bnds $ mkElem <$> range bnds
-
-test :: TestTree
-test = testGroup "Xanthous.Generators.Util"
-  [ testGroup "randInitialize"
-    [ testProperty "returns an array of the correct dimensions"
-      $ \dims seed aliveChance ->
-        let gen = mkStdGen seed
-            res = runSTUArray
-                $ fmap fst
-                $ flip runRandT gen
-                $ randInitialize dims aliveChance
-        in bounds res === (0, V2 (dims ^. width) (dims ^. height))
-    ]
-  , testGroup "numAliveNeighborsM"
-    [ testProperty "maxes out at 8"
-      $ \(GenArray (arr :: Array (V2 Word) Bool)) loc ->
-        let
-          act :: forall s. ST s Word
-          act = do
-            mArr <- thaw @_ @_ @_ @(STUArray s) arr
-            numAliveNeighborsM mArr loc
-          res = runST act
-        in counterexample (show res) $ between 0 8 res
-    ]
-  , testGroup "numAliveNeighbors"
-    [ testProperty "is equivalient to runST . numAliveNeighborsM . thaw" $
-      \(GenArray (arr :: Array (V2 Word) Bool)) loc ->
-        let
-          act :: forall s. ST s Word
-          act = do
-            mArr <- thaw @_ @_ @_ @(STUArray s) arr
-            numAliveNeighborsM mArr loc
-          res = runST act
-        in numAliveNeighbors arr loc === res
-    ]
-  , testGroup "cloneMArray"
-      [ testCase "clones the array" $ runST $
-          let
-            go :: forall s. ST s Assertion
-            go = do
-              arr <- newArray @(STUArray s) (0 :: Int, 5) (1 :: Int)
-              arr' <- cloneMArray @_ @(STUArray s) arr
-              writeArray arr' 0 1234
-              x <- readArray arr 0
-              pure $ x @?= 1
-          in go
-      ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/MessageSpec.hs b/users/glittershark/xanthous/test/Xanthous/MessageSpec.hs
deleted file mode 100644
index b681e537efe6..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/MessageSpec.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE OverloadedLists #-}
-module Xanthous.MessageSpec ( main, test ) where
-
-import Test.Prelude
-import Xanthous.Messages
-import Data.Aeson
-import Text.Mustache
-import Control.Lens.Properties
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Messages"
-  [ testGroup "Message"
-    [ testGroup "JSON decoding"
-      [ testCase "Single"
-        $ decode "\"Test Single Template\""
-        @?= Just (Single
-                  $ compileMustacheText "template" "Test Single Template"
-                  ^?! _Right)
-      , testCase "Choice"
-        $ decode "[\"Choice 1\", \"Choice 2\"]"
-        @?= Just
-            (Choice
-            [ compileMustacheText "template" "Choice 1" ^?! _Right
-            , compileMustacheText "template" "Choice 2" ^?! _Right
-            ])
-      ]
-    ]
-  , localOption (QuickCheckTests 50)
-  . localOption (QuickCheckMaxSize 10)
-  $ testGroup "MessageMap"
-    [ testGroup "instance Ixed"
-        [ testProperty "traversal laws" $ \k ->
-            isTraversal $ ix @MessageMap k
-        , testCase "preview when exists" $
-          let
-            Right tpl = compileMustacheText "foo" "bar"
-            msg = Single tpl
-            mm = Nested $ [("foo", Direct msg)]
-          in mm ^? ix ["foo"] @?= Just msg
-        ]
-    , testGroup "lookupMessage"
-      [ testProperty "is equivalent to preview ix" $ \msgMap path ->
-          lookupMessage path msgMap === msgMap ^? ix path
-      ]
-    ]
-
-  , testGroup "Messages"
-    [ testCase "are all valid" $ messages `deepseq` pure ()
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs b/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
deleted file mode 100644
index 2a3873c3b016..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
+++ /dev/null
@@ -1,80 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Messages.TemplateSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
-import Test.QuickCheck.Instances.Text ()
-import Data.List.NonEmpty (NonEmpty(..))
-import Data.Function (fix)
---------------------------------------------------------------------------------
-import Xanthous.Messages.Template
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Messages.Template"
-  [ testGroup "parsing"
-    [ testProperty "literals" $ forAll genLiteral $ \s ->
-        testParse template s === Right (Literal s)
-    , parseCase "escaped curlies"
-      "foo\\{"
-      $ Literal "foo{"
-    , parseCase "simple substitution"
-      "foo {{bar}}"
-      $ Literal "foo " `Concat` Subst (SubstPath $ "bar" :| [])
-    , parseCase "substitution with filters"
-      "foo {{bar | baz}}"
-      $ Literal "foo "
-      `Concat` Subst (SubstFilter (SubstPath $ "bar" :| [])
-                                  (FilterName "baz"))
-    , parseCase "substitution with multiple filters"
-      "foo {{bar | baz | qux}}"
-      $ Literal "foo "
-      `Concat` Subst (SubstFilter (SubstFilter (SubstPath $ "bar" :| [])
-                                                (FilterName "baz"))
-                                  (FilterName "qux"))
-    , parseCase "two substitutions and a literal"
-      "{{a}}{{b}}c"
-      $ Subst (SubstPath $ "a" :| [])
-      `Concat` Subst (SubstPath $ "b" :| [])
-      `Concat` Literal "c"
-    , localOption (QuickCheckTests 10)
-    $ testProperty "round-trips with ppTemplate" $ \tpl ->
-        testParse template (ppTemplate tpl) === Right tpl
-    ]
-  , testBatch $ monoid @Template mempty
-  , testGroup "rendering"
-    [ testProperty "rendering literals renders literally"
-      $ forAll genLiteral $ \s fs vs ->
-        render fs vs (Literal s) === Right s
-    , testProperty "rendering substitutions renders substitutions"
-      $ forAll genPath $ \ident val fs ->
-        let tpl = Subst (SubstPath ident)
-            tvs = varsWith ident val
-        in render fs tvs tpl === Right val
-    , testProperty "filters filter" $ forAll genPath
-      $ \ident filterName filterFn val ->
-        let tpl = Subst (SubstFilter (SubstPath ident) filterName)
-            fs = mapFromList [(filterName, filterFn)]
-            vs = varsWith ident val
-        in render fs vs tpl === Right (filterFn val)
-    ]
-  ]
-  where
-    genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary
-    parseCase name input expected =
-      testCase name $ testParse template input @?= Right expected
-    testParse p = over _Left errorBundlePretty . runParser p "<test>"
-    genIdentifier = pack @Text <$> listOf1 (elements identifierChars)
-    identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_']
-
-    varsWith (p :| []) val = vars [(p, Val val)]
-    varsWith (phead :| ps) val = vars . pure . (phead ,) . flip fix ps $
-      \next pth -> case pth of
-          [] -> Val val
-          p : ps' -> nested [(p, next ps')]
-
-    genPath = (:|) <$> genIdentifier <*> listOf genIdentifier
-
---
diff --git a/users/glittershark/xanthous/test/Xanthous/OrphansSpec.hs b/users/glittershark/xanthous/test/Xanthous/OrphansSpec.hs
deleted file mode 100644
index 3740945877ef..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/OrphansSpec.hs
+++ /dev/null
@@ -1,42 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
---------------------------------------------------------------------------------
-module Xanthous.OrphansSpec where
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import           Text.Mustache
-import           Text.Megaparsec (errorBundlePretty)
-import           Graphics.Vty.Attributes
-import qualified Data.Aeson as JSON
---------------------------------------------------------------------------------
-import           Xanthous.Orphans
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Orphans"
-  [ localOption (QuickCheckTests 50)
-  . localOption (QuickCheckMaxSize 10)
-  $ testGroup "Template"
-    [ testProperty "ppTemplate / compileMustacheText " \tpl ->
-        let src = ppTemplate tpl
-            res :: Either String Template
-            res = over _Left errorBundlePretty
-                $ compileMustacheText (templateActual tpl) src
-            expected = templateCache tpl ^?! at (templateActual tpl)
-        in
-          counterexample (unpack src)
-          $ Right expected === do
-            (Template actual cache) <- res
-            maybe (Left "Template not found") Right $ cache ^? at actual
-    , testProperty "JSON round trip" $ \(tpl :: Template) ->
-        counterexample (unpack $ ppTemplate tpl)
-        $ JSON.decode (JSON.encode tpl) === Just tpl
-    ]
-  , testGroup "Attr"
-    [ testProperty "JSON round trip" $ \(attr :: Attr) ->
-        JSON.decode (JSON.encode attr) === Just attr
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs b/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
deleted file mode 100644
index 187336f08650..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/RandomSpec.hs
+++ /dev/null
@@ -1,25 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.RandomSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
---------------------------------------------------------------------------------
-import Control.Monad.Random
---------------------------------------------------------------------------------
-import Xanthous.Random
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Random"
-  [ testGroup "chooseSubset"
-    [ testProperty "chooses a subset"
-      $ \(l :: [Int]) (Positive (r :: Double)) -> randomTest $ do
-        ss <- chooseSubset r l
-        pure $ all (`elem` l) ss
-
-    ]
-  ]
-  where
-    randomTest prop = evalRandT prop . mkStdGen =<< arbitrary
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs
deleted file mode 100644
index 35ff090b28b9..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Util/GraphSpec.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-module Xanthous.Util.GraphSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
---------------------------------------------------------------------------------
-import Xanthous.Util.Graph
-import Data.Graph.Inductive.Basic
-import Data.Graph.Inductive.Graph (labNodes, size, order)
-import Data.Graph.Inductive.PatriciaTree
-import Data.Graph.Inductive.Arbitrary
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Util.Graph"
-  [ testGroup "mstSubGraph"
-    [ testProperty "always produces a subgraph"
-        $ \(CG _ (graph :: Gr Int Int)) ->
-          let msg = mstSubGraph $ undir graph
-          in counterexample (show msg)
-            $ msg `isSubGraphOf` undir graph
-    , testProperty "returns a graph with the same nodes"
-        $ \(CG _ (graph :: Gr Int Int)) ->
-          let msg = mstSubGraph graph
-          in counterexample (show msg)
-            $ labNodes msg === labNodes graph
-    , testProperty "has nodes - 1 edges"
-        $ \(CG _ (graph :: Gr Int Int)) ->
-          order graph > 1 ==>
-          let msg = mstSubGraph graph
-          in counterexample (show msg)
-            $ size msg === order graph - 1
-    , testProperty "always produces a simple graph"
-        $ \(CG _ (graph :: Gr Int Int)) ->
-          let msg = mstSubGraph graph
-          in counterexample (show msg) $ isSimple msg
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
deleted file mode 100644
index 61e589280362..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Util/GraphicsSpec.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module Xanthous.Util.GraphicsSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude hiding (head)
---------------------------------------------------------------------------------
-import Data.List (nub, head)
-import Data.Set (isSubsetOf)
-import Linear.V2
---------------------------------------------------------------------------------
-import Xanthous.Util.Graphics
-import Xanthous.Util
-import Xanthous.Orphans ()
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Util.Graphics"
-  [ testGroup "circle"
-    [ testCase "radius 1, origin 2,2"
-      {-
-        |   | 0 | 1 | 2 | 3 |
-        |---+---+---+---+---|
-        | 0 |   |   |   |   |
-        | 1 |   |   | x |   |
-        | 2 |   | x |   | x |
-        | 3 |   |   | x |   |
-      -}
-      $ (sort . unique @[] @[_]) (circle @Int (V2 2 2) 1)
-      @?= [ V2 1 2
-          , V2 2 1, V2 2 3
-          , V2 3 2
-          ]
-    , testCase "radius 12, origin 0"
-      $   (sort . nub) (circle @Int 0 12)
-      @?= (sort . nub)
-          [ V2 (-12) (-4), V2 (-12) (-3), V2 (-12) (-2), V2 (-12) (-1)
-          , V2 (-12) 0, V2 (-12) 1, V2 (-12) 2, V2 (-12) 3, V2 (-12) 4
-          , V2 (-11) (-6), V2 (-11) (-5), V2 (-11) 5, V2 (-11) 6, V2 (-10) (-7)
-          , V2 (-10) 7, V2 (-9) (-9), V2 (-9) (-8), V2 (-9) 8, V2 (-9) 9
-          , V2 (-8) (-9), V2 (-8) 9, V2 (-7) (-10), V2 (-7) 10, V2 (-6) (-11)
-          , V2 (-6) 11, V2 (-5) (-11), V2 (-5) 11, V2 (-4) (-12), V2 (-4) 12
-          , V2 (-3) (-12), V2 (-3) 12, V2 (-2) (-12), V2 (-2) 12, V2 (-1) (-12)
-          , V2 (-1) 12, V2 0 (-12), V2 0 12, V2 1 (-12), V2 1 12, V2 2 (-12)
-          , V2 2 12, V2 3 (-12), V2 3 12, V2 4 (-12), V2 4 12, V2 5 (-11)
-          , V2 5 11, V2 6 (-11), V2 6 11, V2 7 (-10), V2 7 10, V2 8 (-9), V2 8 9
-          , V2 9 (-9), V2 9 (-8), V2 9 8, V2 9 9, V2 10 (-7), V2 10 7
-          , V2 11 (-6), V2 11 (-5), V2 11 5, V2 11 6, V2 12 (-4), V2 12 (-3)
-          , V2 12 (-2), V2 12 (-1), V2 12 0, V2 12 1, V2 12 2, V2 12 3, V2 12 4
-          ]
-    ]
-  , testGroup "filledCircle"
-    [ testProperty "is a superset of circle" $ \center radius ->
-        let circ = circle @Int center radius
-            filledCirc = filledCircle center radius
-        in counterexample ( "circle: " <> show circ
-                           <> "\nfilledCircle: " <> show filledCirc)
-          $ setFromList circ `isSubsetOf` setFromList filledCirc
-    -- TODO later
-    -- , testProperty "is always contiguous" $ \center radius ->
-    --     let filledCirc = filledCircle center radius
-    --     in counterexample (renderBooleanGraphics filledCirc) $
-    ]
-  , testGroup "line"
-    [ testProperty "starts and ends at the start and end points" $ \start end ->
-        let ℓ = line @Int start end
-        in counterexample ("line: " <> show ℓ)
-        $ length ℓ > 2 ==> (head ℓ === start) .&&. (head (reverse ℓ) === end)
-    ]
-  ]
-
---------------------------------------------------------------------------------
diff --git a/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs b/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs
deleted file mode 100644
index fad841043152..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/Util/InflectionSpec.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module Xanthous.Util.InflectionSpec (main, test) where
-
-import Test.Prelude
-import Xanthous.Util.Inflection
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Util.Inflection"
-  [ testGroup "toSentence"
-    [ testCase "empty"  $ toSentence [] @?= ""
-    , testCase "single" $ toSentence ["x"] @?= "x"
-    , testCase "two"    $ toSentence ["x", "y"] @?= "x and y"
-    , testCase "three"  $ toSentence ["x", "y", "z"] @?= "x, y, and z"
-    , testCase "four"   $ toSentence ["x", "y", "z", "w"] @?= "x, y, z, and w"
-    ]
-  ]
diff --git a/users/glittershark/xanthous/test/Xanthous/UtilSpec.hs b/users/glittershark/xanthous/test/Xanthous/UtilSpec.hs
deleted file mode 100644
index 8538ea5098ba..000000000000
--- a/users/glittershark/xanthous/test/Xanthous/UtilSpec.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-module Xanthous.UtilSpec (main, test) where
-
-import Test.Prelude
-import Xanthous.Util
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Util"
-  [ testGroup "smallestNotIn"
-    [ testCase "examples" $ do
-        smallestNotIn [7 :: Word, 3, 7] @?= 0
-        smallestNotIn [7 :: Word, 0, 1, 3, 7] @?= 2
-    , testProperty "returns an element not in the list" $ \(xs :: [Word]) ->
-        smallestNotIn xs `notElem` xs
-    , testProperty "pred return is in the list" $ \(xs :: [Word]) ->
-        let res = smallestNotIn xs
-        in res /= 0 ==> pred res `elem` xs
-    , testProperty "ignores order" $ \(xs :: [Word]) ->
-        forAll (shuffle xs) $ \shuffledXs ->
-          smallestNotIn xs === smallestNotIn shuffledXs
-    ]
-  , testGroup "takeWhileInclusive"
-    [ testProperty "takeWhileInclusive (const True) ≡ id"
-      $ \(xs :: [Int]) -> takeWhileInclusive (const True) xs === xs
-    ]
-  ]