about summary refs log tree commit diff
path: root/users/grfn/xanthous/test
diff options
context:
space:
mode:
authorAspen Smith <grfn@gws.fyi>2024-02-12T03·00-0500
committerclbot <clbot@tvl.fyi>2024-02-14T19·37+0000
commit82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 (patch)
tree429c5e078528000591742ec3211bc768ae913a78 /users/grfn/xanthous/test
parent0ba476a4266015f278f18d74094299de74a5a111 (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')
-rw-r--r--users/grfn/xanthous/test/Spec.hs61
-rw-r--r--users/grfn/xanthous/test/Test/Prelude.hs34
-rw-r--r--users/grfn/xanthous/test/Xanthous/CommandSpec.hs40
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs28
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs18
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs57
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs69
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs66
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs19
-rw-r--r--users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs20
-rw-r--r--users/grfn/xanthous/test/Xanthous/DataSpec.hs109
-rw-r--r--users/grfn/xanthous/test/Xanthous/Entities/CharacterSpec.hs24
-rw-r--r--users/grfn/xanthous/test/Xanthous/Entities/CommonSpec.hs65
-rw-r--r--users/grfn/xanthous/test/Xanthous/Entities/RawTypesSpec.hs45
-rw-r--r--users/grfn/xanthous/test/Xanthous/Entities/RawsSpec.hs30
-rw-r--r--users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs19
-rw-r--r--users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs30
-rw-r--r--users/grfn/xanthous/test/Xanthous/GameSpec.hs55
-rw-r--r--users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs127
-rw-r--r--users/grfn/xanthous/test/Xanthous/MessageSpec.hs59
-rw-r--r--users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs80
-rw-r--r--users/grfn/xanthous/test/Xanthous/OrphansSpec.hs72
-rw-r--r--users/grfn/xanthous/test/Xanthous/RandomSpec.hs45
-rw-r--r--users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs39
-rw-r--r--users/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs72
-rw-r--r--users/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs18
-rw-r--r--users/grfn/xanthous/test/Xanthous/UtilSpec.hs46
27 files changed, 0 insertions, 1347 deletions
diff --git a/users/grfn/xanthous/test/Spec.hs b/users/grfn/xanthous/test/Spec.hs
deleted file mode 100644
index 51758d6a25ec..000000000000
--- a/users/grfn/xanthous/test/Spec.hs
+++ /dev/null
@@ -1,61 +0,0 @@
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import qualified Xanthous.CommandSpec
-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.MemoSpec
-import qualified Xanthous.Data.NestedMapSpec
-import qualified Xanthous.DataSpec
-import qualified Xanthous.Entities.CommonSpec
-import qualified Xanthous.Entities.RawsSpec
-import qualified Xanthous.Entities.RawTypesSpec
-import qualified Xanthous.Entities.CharacterSpec
-import qualified Xanthous.GameSpec
-import qualified Xanthous.Game.StateSpec
-import qualified Xanthous.Game.PromptSpec
-import qualified Xanthous.Generators.Level.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 = defaultMainWithRerun test
-
-test :: TestTree
-test = testGroup "Xanthous"
-  [ Xanthous.CommandSpec.test
-  , Xanthous.Data.EntitiesSpec.test
-  , Xanthous.Data.EntityMap.GraphicsSpec.test
-  , Xanthous.Data.EntityMapSpec.test
-  , Xanthous.Data.LevelsSpec.test
-  , Xanthous.Data.MemoSpec.test
-  , Xanthous.Data.NestedMapSpec.test
-  , Xanthous.DataSpec.test
-  , Xanthous.Entities.CommonSpec.test
-  , Xanthous.Entities.RawsSpec.test
-  , Xanthous.Entities.CharacterSpec.test
-  , Xanthous.Entities.RawTypesSpec.test
-  , Xanthous.GameSpec.test
-  , Xanthous.Game.StateSpec.test
-  , Xanthous.Game.PromptSpec.test
-  , Xanthous.Generators.Level.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/grfn/xanthous/test/Test/Prelude.hs b/users/grfn/xanthous/test/Test/Prelude.hs
deleted file mode 100644
index 75c1ebf5e76a..000000000000
--- a/users/grfn/xanthous/test/Test/Prelude.hs
+++ /dev/null
@@ -1,34 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
---------------------------------------------------------------------------------
-module Test.Prelude
-  ( module Xanthous.Prelude
-  , module Test.Tasty
-  , module Test.Tasty.HUnit
-  , module Test.Tasty.QuickCheck
-  , module Test.Tasty.Ingredients.Rerun
-  , module Test.QuickCheck.Classes
-  , testBatch
-  , jsonRoundTrip
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (assert, elements)
---------------------------------------------------------------------------------
-import           Test.Tasty
-import           Test.Tasty.QuickCheck
-import           Test.Tasty.HUnit
-import           Test.Tasty.Ingredients.Rerun
-import           Test.QuickCheck.Classes
-import           Test.QuickCheck.Checkers (TestBatch, EqProp ((=-=)))
-import           Test.QuickCheck.Instances.ByteString ()
---------------------------------------------------------------------------------
-import qualified Data.Aeson as JSON
-import           Data.Aeson (ToJSON, FromJSON)
---------------------------------------------------------------------------------
-
-testBatch :: TestBatch -> TestTree
-testBatch (name, tests) = testGroup name $ uncurry testProperty <$> tests
-
-jsonRoundTrip
-  :: forall a. (ToJSON a, FromJSON a, EqProp a, Arbitrary a, Show a) => TestTree
-jsonRoundTrip = testProperty "JSON round trip" $ \(x :: a) ->
-  JSON.decode (JSON.encode x) =-= Just x
diff --git a/users/grfn/xanthous/test/Xanthous/CommandSpec.hs b/users/grfn/xanthous/test/Xanthous/CommandSpec.hs
deleted file mode 100644
index 13f69a808d02..000000000000
--- a/users/grfn/xanthous/test/Xanthous/CommandSpec.hs
+++ /dev/null
@@ -1,40 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.CommandSpec (main, test) where
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import           Xanthous.Command
---------------------------------------------------------------------------------
-import           Data.Aeson (fromJSON, Value(String))
-import qualified Data.Aeson as A
-import           Graphics.Vty.Input (Key(..), Modifier(..))
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.CommandSpec"
-  [ testGroup "keybindings"
-    [ testCase "all are valid" $ keybindings `deepseq` pure ()
-    , testProperty "all non-move commands are bound" $ \cmd ->
-        let isn'tMove = case cmd of
-                          Move _ -> False
-                          StartAutoMove _ -> False
-                          _ -> True
-        in isn'tMove ==> member cmd commands
-    ]
-  , testGroup "instance FromJSON Keybinding" $
-    [ ("q", Keybinding (KChar 'q') [])
-    , ("<up>", Keybinding KUp [])
-    , ("<left>", Keybinding KLeft [])
-    , ("<right>", Keybinding KRight [])
-    , ("<down>", Keybinding KDown [])
-    , ("S-q", Keybinding (KChar 'q') [MShift])
-    , ("C-S-q", Keybinding (KChar 'q') [MCtrl, MShift])
-    , ("m-<UP>", Keybinding KUp [MMeta])
-    , ("S", Keybinding (KChar 'S') [])
-    ] <&> \(s, kb) ->
-      testCase (fromString $ unpack s <> " -> " <> show kb)
-       $ fromJSON (String s) @?= A.Success kb
-  ]
diff --git a/users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntitiesSpec.hs
deleted file mode 100644
index e403503743c0..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityCharSpec.hs
deleted file mode 100644
index 9e8024c9d223..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityMap/GraphicsSpec.hs
deleted file mode 100644
index fd37548ce864..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/EntityMapSpec.hs
deleted file mode 100644
index 7c5cad019616..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs
deleted file mode 100644
index a7528331627d..000000000000
--- a/users/grfn/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 (toEnum $ 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 (toEnum $ 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 (toEnum $ 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/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs
deleted file mode 100644
index ad81f1984d8f..000000000000
--- a/users/grfn/xanthous/test/Xanthous/Data/MemoSpec.hs
+++ /dev/null
@@ -1,19 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Data.MemoSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
-import Test.QuickCheck.Instances.Text ()
---------------------------------------------------------------------------------
-import Xanthous.Data.Memo
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Data.MemoSpec"
-  [ testGroup "getMemoized"
-    [ testProperty "when key matches" $ \k v ->
-        getMemoized @Int @Int k (memoizeWith k v) === Just v
-    ]
-  ]
diff --git a/users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/NestedMapSpec.hs
deleted file mode 100644
index acf7a67268f4..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/DataSpec.hs b/users/grfn/xanthous/test/Xanthous/DataSpec.hs
deleted file mode 100644
index 9e67505ba928..000000000000
--- a/users/grfn/xanthous/test/Xanthous/DataSpec.hs
+++ /dev/null
@@ -1,109 +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
-      ]
-    ]
-
-  , testGroup "units"
-    [ testGroup "unit suffixes"
-      [ testCase "density"
-        $ tshow (10000 :: Grams `Per` Cubic Meters) @?= "10000.0 g/m³"
-      , testCase "volume"
-        $ tshow (5 :: Cubic Meters) @?= "5.0 m³"
-      , testCase "area"
-        $ tshow (5 :: Square Meters) @?= "5.0 m²"
-      ]
-    ]
-  ]
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)
-    ]
-  ]
diff --git a/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs b/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs
deleted file mode 100644
index d7a3df4acafa..000000000000
--- a/users/grfn/xanthous/test/Xanthous/Game/PromptSpec.hs
+++ /dev/null
@@ -1,19 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Game.PromptSpec (main, test) where
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import           Xanthous.Game.Prompt
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Game.PromptSpec"
-  [ testGroup "mkMenuItems"
-    [ testCase "with duplicate items"
-      $ mkMenuItems @[_] [('a', MenuOption @Int "a" 1), ('a', MenuOption "a" 2)]
-        @?= mapFromList [('a', MenuOption "a" 1), ('b', MenuOption "a" 2)]
-    ]
-  ]
diff --git a/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs b/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs
deleted file mode 100644
index 34584f73b2ad..000000000000
--- a/users/grfn/xanthous/test/Xanthous/Game/StateSpec.hs
+++ /dev/null
@@ -1,30 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Game.StateSpec (main, test) where
---------------------------------------------------------------------------------
-import           Test.Prelude
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import           Xanthous.Entities.Raws (raws)
-import           Xanthous.Generators.Level.LevelContents (entityFromRaw)
-import           Control.Monad.Random (evalRandT)
-import           System.Random (getStdGen)
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain test
-
-test :: TestTree
-test = testGroup "Xanthous.Game.StateSpec"
-  [ testGroup "entityTypeName"
-    [ testCase "for a creature" $ do
-        let gormlakRaw = raws ^?! ix "gormlak"
-        creature <- runRand $ entityFromRaw gormlakRaw
-        entityTypeName creature @?= "Creature"
-    , testCase "for an item" $ do
-        let stickRaw = raws ^?! ix "stick"
-        item <- runRand $ entityFromRaw stickRaw
-        entityTypeName item @?= "Item"
-    ]
-  ]
-  where
-    runRand x = evalRandT x =<< getStdGen
diff --git a/users/grfn/xanthous/test/Xanthous/GameSpec.hs b/users/grfn/xanthous/test/Xanthous/GameSpec.hs
deleted file mode 100644
index 2fa8527d0e59..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs b/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs
deleted file mode 100644
index b53c657f7559..000000000000
--- a/users/grfn/xanthous/test/Xanthous/Generators/Level/UtilSpec.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-{-# LANGUAGE PackageImports #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.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, array)
-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.Level.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
-    , testCase "on the outer x edge" $
-      let act :: forall s. ST s Word
-          act = do
-            cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
-              (V2 0 0, V2 2 2)
-              [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
-              , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
-              , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
-              ]
-            numAliveNeighborsM cells (V2 0 1)
-          res = runST act
-      in res @?= 7
-    , testCase "on the outer y edge" $
-      let act :: forall s. ST s Word
-          act = do
-            cells <- thaw @_ @_ @_ @(STUArray s) $ array @Array @Bool @(V2 Word)
-              (V2 0 0, V2 2 2)
-              [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
-              , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
-              , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
-              ]
-            numAliveNeighborsM cells (V2 1 0)
-          res = runST act
-      in res @?= 6
-    ]
-  , 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
-    , testCase "on the outer x edge" $
-      let cells =
-            array @Array @Bool @(V2 Word)
-            (V2 0 0, V2 2 2)
-            [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
-            , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
-            , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
-            ]
-      in numAliveNeighbors cells (V2 0 1) @?= 7
-    , testCase "on the outer y edge" $
-      let cells =
-            array @Array @Bool @(V2 Word)
-            (V2 0 0, V2 2 2)
-            [ (V2 0 0, True),  (V2 1 0, True),  (V2 2 0, True)
-            , (V2 0 1, False), (V2 1 1, False), (V2 2 1, True)
-            , (V2 0 2, True),  (V2 1 2, True),  (V2 2 2, True)
-            ]
-      in numAliveNeighbors cells (V2 1 0) @?= 6
-    ]
-  , 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/grfn/xanthous/test/Xanthous/MessageSpec.hs b/users/grfn/xanthous/test/Xanthous/MessageSpec.hs
deleted file mode 100644
index 2068e338bafe..000000000000
--- a/users/grfn/xanthous/test/Xanthous/MessageSpec.hs
+++ /dev/null
@@ -1,59 +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 ()
-    ]
-
-  , testGroup "Template"
-    [ testGroup "eq"
-      [ testProperty "reflexive" $ \(tpl :: Template) -> tpl == tpl
-      ]
-    ]
-  ]
diff --git a/users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs b/users/grfn/xanthous/test/Xanthous/Messages/TemplateSpec.hs
deleted file mode 100644
index 2a3873c3b016..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/OrphansSpec.hs b/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs
deleted file mode 100644
index 0d800e8a91de..000000000000
--- a/users/grfn/xanthous/test/Xanthous/OrphansSpec.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE OverloadedLists #-}
---------------------------------------------------------------------------------
-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           Data.Interval (Interval, (<=..<=), (<=..<), (<..<=))
-import           Data.Aeson ( ToJSON(toJSON), object, Value(Array) )
-import           Data.Aeson.Types (fromJSON)
-import           Data.IntegerInterval (Extended(Finite))
---------------------------------------------------------------------------------
-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"
-    [ jsonRoundTrip @Attr ]
-  , testGroup "Extended"
-    [ jsonRoundTrip @(Extended Int) ]
-  , testGroup "Interval"
-    [ testGroup "JSON"
-      [ jsonRoundTrip @(Interval Int)
-      , testCase "parses a single value as a length-1 interval" $
-          getSuccess (fromJSON $ toJSON (1 :: Int))
-          @?= Just (Finite (1 :: Int) <=..<= Finite 1)
-      , testCase "parses a pair of values as a single-ended interval" $
-          getSuccess (fromJSON $ toJSON ([1, 2] :: [Int]))
-          @?= Just (Finite (1 :: Int) <=..< Finite (2 :: Int))
-      , testCase "parses the full included/excluded syntax" $
-          getSuccess (fromJSON $ Array [ object [ "Excluded" JSON..= (1 :: Int) ]
-                                       , object [ "Included" JSON..= (4 :: Int) ]
-                                       ])
-          @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int))
-      , testCase "parses open/closed as aliases" $
-          getSuccess (fromJSON $ Array [ object [ "Open" JSON..= (1 :: Int) ]
-                                       , object [ "Closed" JSON..= (4 :: Int) ]
-                                       ])
-          @?= Just (Finite (1 :: Int) <..<= Finite (4 :: Int))
-      ]
-    ]
-  ]
-  where
-    getSuccess :: JSON.Result a -> Maybe a
-    getSuccess (JSON.Error _) = Nothing
-    getSuccess (JSON.Success r) = Just r
diff --git a/users/grfn/xanthous/test/Xanthous/RandomSpec.hs b/users/grfn/xanthous/test/Xanthous/RandomSpec.hs
deleted file mode 100644
index c88bd9562928..000000000000
--- a/users/grfn/xanthous/test/Xanthous/RandomSpec.hs
+++ /dev/null
@@ -1,45 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.RandomSpec (main, test) where
---------------------------------------------------------------------------------
-import Test.Prelude
---------------------------------------------------------------------------------
-import Control.Monad.Random
---------------------------------------------------------------------------------
-import           Xanthous.Random
-import           Xanthous.Orphans ()
-import qualified Data.Interval as Interval
-import           Data.Interval (Interval, Extended (Finite), (<=..<=))
---------------------------------------------------------------------------------
-
-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
-    ]
-  , testGroup "chooseRange"
-    [ testProperty "chooses in the range"
-      $ \(rng :: Interval Int) ->
-        not (Interval.null rng)
-        ==> randomTest ( do
-                chooseRange rng >>= \case
-                  Just r -> pure
-                           . counterexample (show r)
-                           $ r `Interval.member` rng
-                  Nothing -> pure $ property Discard
-            )
-    , testProperty "nonEmpty range is never empty"
-      $ \ (lower :: Int) (NonZero diff) -> randomTest $ do
-        let upper = lower + diff
-        r <- chooseRange (Finite lower <=..<= Finite upper)
-        pure $ isJust r
-
-    ]
-  ]
-  where
-    randomTest prop = evalRandT prop . mkStdGen =<< arbitrary
diff --git a/users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/GraphSpec.hs
deleted file mode 100644
index 35ff090b28b9..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/GraphicsSpec.hs
deleted file mode 100644
index 61e589280362..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs b/users/grfn/xanthous/test/Xanthous/Util/InflectionSpec.hs
deleted file mode 100644
index fad841043152..000000000000
--- a/users/grfn/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/grfn/xanthous/test/Xanthous/UtilSpec.hs b/users/grfn/xanthous/test/Xanthous/UtilSpec.hs
deleted file mode 100644
index 684a03b2c7a0..000000000000
--- a/users/grfn/xanthous/test/Xanthous/UtilSpec.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-module Xanthous.UtilSpec (main, test) where
-
-import Test.Prelude
-import Xanthous.Util
-import Control.Monad.State.Lazy (execState)
-
-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
-    ]
-  , testGroup "endoTimes"
-    [ testCase "endoTimes 4 succ 5"
-      $ endoTimes (4 :: Int) succ (5 :: Int) @?= 9
-    ]
-  , testGroup "modifyKL"
-    [ testCase "_1 += 1"
-      $ execState (modifyKL _1 $ pure . succ) (1 :: Int, 2 :: Int) @?= (2, 2)
-    ]
-  , testGroup "removeFirst"
-    [ testCase "example" $
-      removeFirst @[Int] (> 5) [1..10] @?= [1, 2, 3, 4, 5, 7, 8, 9, 10]
-    , testProperty "the result is the right length" $ \(xs :: [Int]) p ->
-        length (removeFirst p xs) `elem` [length xs, length xs - 1]
-    ]
-  , testGroup "AlphaChar"
-    [ testCase "succ 'z'" $ succ (AlphaChar 'z') @?= AlphaChar 'A'
-    ]
-  ]