about summary refs log tree commit diff
path: root/users/grfn/xanthous
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
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')
-rw-r--r--users/grfn/xanthous/.envrc1
-rw-r--r--users/grfn/xanthous/.github/actions/nix-build/Dockerfile23
-rwxr-xr-xusers/grfn/xanthous/.github/actions/nix-build/entrypoint.sh24
-rw-r--r--users/grfn/xanthous/.github/workflows/haskell.yml15
-rw-r--r--users/grfn/xanthous/.gitignore37
-rw-r--r--users/grfn/xanthous/LICENSE674
-rw-r--r--users/grfn/xanthous/README.org36
-rw-r--r--users/grfn/xanthous/Setup.hs2
-rw-r--r--users/grfn/xanthous/app/Main.hs171
-rw-r--r--users/grfn/xanthous/bench/Bench.hs12
-rw-r--r--users/grfn/xanthous/bench/Bench/Prelude.hs9
-rw-r--r--users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs37
-rw-r--r--users/grfn/xanthous/bench/Xanthous/RandomBench.hs32
-rw-r--r--users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch12
-rw-r--r--users/grfn/xanthous/build/hgeometry-fix-haddock.patch13
-rw-r--r--users/grfn/xanthous/build/update-comonad-extras.patch92
-rw-r--r--users/grfn/xanthous/default.nix27
-rw-r--r--users/grfn/xanthous/docs/raw-types.org24
-rw-r--r--users/grfn/xanthous/hie.yaml10
-rw-r--r--users/grfn/xanthous/nixpkgs.nix3
-rw-r--r--users/grfn/xanthous/package.yaml157
-rw-r--r--users/grfn/xanthous/pkg.nix349
-rw-r--r--users/grfn/xanthous/server/.envrc1
-rw-r--r--users/grfn/xanthous/server/.gitignore1
-rw-r--r--users/grfn/xanthous/server/Cargo.lock1874
-rw-r--r--users/grfn/xanthous/server/Cargo.toml29
-rw-r--r--users/grfn/xanthous/server/default.nix24
-rw-r--r--users/grfn/xanthous/server/docker.nix21
-rw-r--r--users/grfn/xanthous/server/module.nix49
-rw-r--r--users/grfn/xanthous/server/shell.nix11
-rw-r--r--users/grfn/xanthous/server/src/main.rs385
-rw-r--r--users/grfn/xanthous/server/src/metrics.rs24
-rw-r--r--users/grfn/xanthous/server/src/pty.rs172
-rw-r--r--users/grfn/xanthous/shell.nix23
-rw-r--r--users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs168
-rw-r--r--users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs201
-rw-r--r--users/grfn/xanthous/src/Xanthous/App.hs647
-rw-r--r--users/grfn/xanthous/src/Xanthous/App/Autocommands.hs76
-rw-r--r--users/grfn/xanthous/src/Xanthous/App/Common.hs67
-rw-r--r--users/grfn/xanthous/src/Xanthous/App/Prompt.hs228
-rw-r--r--users/grfn/xanthous/src/Xanthous/App/Time.hs42
-rw-r--r--users/grfn/xanthous/src/Xanthous/Command.hs145
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data.hs822
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/App.hs47
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Entities.hs68
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs56
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs276
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs72
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Levels.hs180
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Memo.hs98
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs227
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs100
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Character.hs241
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Common.hs290
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Creature.hs88
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs71
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs31
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Entities.hs63
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot14
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Environment.hs160
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Item.hs76
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Marker.hs41
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs286
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws.hs49
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml24
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml20
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml26
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml14
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml15
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml10
-rw-r--r--users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml22
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game.hs73
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs53
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Draw.hs224
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Env.hs37
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Lenses.hs178
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Memo.hs52
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/Prompt.hs359
-rw-r--r--users/grfn/xanthous/src/Xanthous/Game/State.hs572
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level.hs172
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs112
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs190
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs182
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs236
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs126
-rw-r--r--users/grfn/xanthous/src/Xanthous/Generators/Speech.hs181
-rw-r--r--users/grfn/xanthous/src/Xanthous/Messages.hs114
-rw-r--r--users/grfn/xanthous/src/Xanthous/Messages/Template.hs275
-rw-r--r--users/grfn/xanthous/src/Xanthous/Monad.hs76
-rw-r--r--users/grfn/xanthous/src/Xanthous/Orphans.hs495
-rw-r--r--users/grfn/xanthous/src/Xanthous/Physics.hs71
-rw-r--r--users/grfn/xanthous/src/Xanthous/Prelude.hs48
-rw-r--r--users/grfn/xanthous/src/Xanthous/Random.hs186
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util.hs351
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/Comonad.hs24
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/Graph.hs33
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/Graphics.hs177
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/Inflection.hs14
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/JSON.hs19
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/Optparse.hs21
-rw-r--r--users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs32
-rw-r--r--users/grfn/xanthous/src/Xanthous/keybindings.yaml22
-rw-r--r--users/grfn/xanthous/src/Xanthous/messages.yaml161
-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
-rw-r--r--users/grfn/xanthous/xanthous.cabal529
131 files changed, 0 insertions, 16177 deletions
diff --git a/users/grfn/xanthous/.envrc b/users/grfn/xanthous/.envrc
deleted file mode 100644
index be81feddb1a5..000000000000
--- a/users/grfn/xanthous/.envrc
+++ /dev/null
@@ -1 +0,0 @@
-eval "$(lorri direnv)"
\ No newline at end of file
diff --git a/users/grfn/xanthous/.github/actions/nix-build/Dockerfile b/users/grfn/xanthous/.github/actions/nix-build/Dockerfile
deleted file mode 100644
index cfe8e35df091..000000000000
--- a/users/grfn/xanthous/.github/actions/nix-build/Dockerfile
+++ /dev/null
@@ -1,23 +0,0 @@
-FROM lnl7/nix:2.1.2
-
-LABEL name="Nix Build for GitHub Actions"
-LABEL version="1.0"
-LABEL repository="http://github.com/glittershark/xanthous"
-LABEL homepage="http://github.com/glittershark/xanthous"
-LABEL maintainer="Griffin Smith <root at gws dot fyi>"
-
-LABEL "com.github.actions.name"="Nix Build"
-LABEL "com.github.actions.description"="Runs 'nix-build'"
-LABEL "com.github.actions.icon"="cpu"
-LABEL "com.github.actions.color"="purple"
-
-RUN nix-env -iA \
-  nixpkgs.gnutar nixpkgs.gzip \
-  nixpkgs.gnugrep nixpkgs.git && \
-  mkdir -p /etc/nix && \
-  (echo "binary-caches = https://cache.nixos.org/" | tee -a /etc/nix/nix.conf) && \
-  (echo "trusted-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY=" | tee -a /etc/nix/nix.conf)
-
-COPY entrypoint.sh /entrypoint.sh
-ENTRYPOINT [ "/entrypoint.sh" ]
-CMD [ "--help" ]
diff --git a/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh b/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh
deleted file mode 100755
index cb7aca541a3f..000000000000
--- a/users/grfn/xanthous/.github/actions/nix-build/entrypoint.sh
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/usr/bin/env bash
-
-# Entrypoint that runs nix-build and, optionally, copies Docker image tarballs
-# to real files. The reason this is necessary is because once a Nix container
-# exits, you must copy out the artifacts to the working directory before exit.
-
-[ "$DEBUG" = "1" ] && set -x
-[ "$QUIET" = "1" ] && QUIET_ARG="-Q"
-
-set -e
-
-# file to build (e.g. release.nix)
-file="$1"
-
-[ "$file" = "" ] && echo "No .nix file to build specified!" && exit 1
-[ ! -e "$file" ] && echo "File $file not exist!" && exit 1
-
-echo "Building all attrs in $file..."
-nix-build --no-link ${QUIET_ARG} "$file" "${@:2}"
-
-echo "Copying build closure to $(pwd)/store..."
-mapfile -t storePaths < <(nix-build ${QUIET_ARG} --no-link "$file" | grep -v cache-deps)
-printf '%s\n' "${storePaths[@]}" > store.roots
-nix copy --to "file://$(pwd)/store" "${storePaths[@]}"
diff --git a/users/grfn/xanthous/.github/workflows/haskell.yml b/users/grfn/xanthous/.github/workflows/haskell.yml
deleted file mode 100644
index df82de3e8caf..000000000000
--- a/users/grfn/xanthous/.github/workflows/haskell.yml
+++ /dev/null
@@ -1,15 +0,0 @@
-name: Haskell CI
-
-on: [push]
-
-jobs:
-  build:
-
-    runs-on: ubuntu-latest
-
-    steps:
-    - uses: actions/checkout@v1
-    - name: Nix Build
-      with:
-        args: default.nix --arg failOnWarnings true
-      uses: ./.github/actions/nix-build
diff --git a/users/grfn/xanthous/.gitignore b/users/grfn/xanthous/.gitignore
deleted file mode 100644
index 2ad31c01d443..000000000000
--- a/users/grfn/xanthous/.gitignore
+++ /dev/null
@@ -1,37 +0,0 @@
-dist
-dist-*
-cabal-dev
-*.o
-*.hi
-*.hie
-*.chi
-*.chs.h
-*.dyn_o
-*.dyn_hi
-.hpc
-.hsenv
-.cabal-sandbox/
-cabal.sandbox.config
-*.prof
-*.aux
-*.hp
-*.eventlog
-.stack-work/
-cabal.project.local
-cabal.project.local~
-cabal.project.local~*
-.HTF/
-.ghc.environment.*
-
-
-# from nix-build
-result
-
-# grr
-*_flymake.hs
-
-# app-specific
-debug.log
-data
-*.save
-.tasty-rerun-log
diff --git a/users/grfn/xanthous/LICENSE b/users/grfn/xanthous/LICENSE
deleted file mode 100644
index 45644ff76449..000000000000
--- a/users/grfn/xanthous/LICENSE
+++ /dev/null
@@ -1,674 +0,0 @@
-              GNU GENERAL PUBLIC LICENSE
-                Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-                     Preamble
-
-  The GNU General Public License is a free, copyleft license for
-software and other kinds of works.
-
-  The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works.  By contrast,
-the GNU General Public License is intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users.  We, the Free Software Foundation, use the
-GNU General Public License for most of our software; it applies also to
-any other work released this way by its authors.  You can apply it to
-your programs, too.
-
-  When we speak of free software, we are referring to freedom, not
-price.  Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
-  To protect your rights, we need to prevent others from denying you
-these rights or asking you to surrender the rights.  Therefore, you have
-certain responsibilities if you distribute copies of the software, or if
-you modify it: responsibilities to respect the freedom of others.
-
-  For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must pass on to the recipients the same
-freedoms that you received.  You must make sure that they, too, receive
-or can get the source code.  And you must show them these terms so they
-know their rights.
-
-  Developers that use the GNU GPL protect your rights with two steps:
-(1) assert copyright on the software, and (2) offer you this License
-giving you legal permission to copy, distribute and/or modify it.
-
-  For the developers' and authors' protection, the GPL clearly explains
-that there is no warranty for this free software.  For both users' and
-authors' sake, the GPL requires that modified versions be marked as
-changed, so that their problems will not be attributed erroneously to
-authors of previous versions.
-
-  Some devices are designed to deny users access to install or run
-modified versions of the software inside them, although the manufacturer
-can do so.  This is fundamentally incompatible with the aim of
-protecting users' freedom to change the software.  The systematic
-pattern of such abuse occurs in the area of products for individuals to
-use, which is precisely where it is most unacceptable.  Therefore, we
-have designed this version of the GPL to prohibit the practice for those
-products.  If such problems arise substantially in other domains, we
-stand ready to extend this provision to those domains in future versions
-of the GPL, as needed to protect the freedom of users.
-
-  Finally, every program is threatened constantly by software patents.
-States should not allow patents to restrict development and use of
-software on general-purpose computers, but in those that do, we wish to
-avoid the special danger that patents applied to a free program could
-make it effectively proprietary.  To prevent this, the GPL assures that
-patents cannot be used to render the program non-free.
-
-  The precise terms and conditions for copying, distribution and
-modification follow.
-
-                TERMS AND CONDITIONS
-
-  0. Definitions.
-
-  "This License" refers to version 3 of the GNU General Public License.
-
-  "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
-  "The Program" refers to any copyrightable work licensed under this
-License.  Each licensee is addressed as "you".  "Licensees" and
-"recipients" may be individuals or organizations.
-
-  To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy.  The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
-  A "covered work" means either the unmodified Program or a work based
-on the Program.
-
-  To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy.  Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
-  To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies.  Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
-  An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License.  If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
-  1. Source Code.
-
-  The "source code" for a work means the preferred form of the work
-for making modifications to it.  "Object code" means any non-source
-form of a work.
-
-  A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
-  The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form.  A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
-  The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities.  However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work.  For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
-  The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
-  The Corresponding Source for a work in source code form is that
-same work.
-
-  2. Basic Permissions.
-
-  All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met.  This License explicitly affirms your unlimited
-permission to run the unmodified Program.  The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work.  This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
-  You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force.  You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright.  Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
-  Conveying under any other circumstances is permitted solely under
-the conditions stated below.  Sublicensing is not allowed; section 10
-makes it unnecessary.
-
-  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
-  No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
-  When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
-  4. Conveying Verbatim Copies.
-
-  You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
-  You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
-  5. Conveying Modified Source Versions.
-
-  You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
-    a) The work must carry prominent notices stating that you modified
-    it, and giving a relevant date.
-
-    b) The work must carry prominent notices stating that it is
-    released under this License and any conditions added under section
-    7.  This requirement modifies the requirement in section 4 to
-    "keep intact all notices".
-
-    c) You must license the entire work, as a whole, under this
-    License to anyone who comes into possession of a copy.  This
-    License will therefore apply, along with any applicable section 7
-    additional terms, to the whole of the work, and all its parts,
-    regardless of how they are packaged.  This License gives no
-    permission to license the work in any other way, but it does not
-    invalidate such permission if you have separately received it.
-
-    d) If the work has interactive user interfaces, each must display
-    Appropriate Legal Notices; however, if the Program has interactive
-    interfaces that do not display Appropriate Legal Notices, your
-    work need not make them do so.
-
-  A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit.  Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
-  6. Conveying Non-Source Forms.
-
-  You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
-    a) Convey the object code in, or embodied in, a physical product
-    (including a physical distribution medium), accompanied by the
-    Corresponding Source fixed on a durable physical medium
-    customarily used for software interchange.
-
-    b) Convey the object code in, or embodied in, a physical product
-    (including a physical distribution medium), accompanied by a
-    written offer, valid for at least three years and valid for as
-    long as you offer spare parts or customer support for that product
-    model, to give anyone who possesses the object code either (1) a
-    copy of the Corresponding Source for all the software in the
-    product that is covered by this License, on a durable physical
-    medium customarily used for software interchange, for a price no
-    more than your reasonable cost of physically performing this
-    conveying of source, or (2) access to copy the
-    Corresponding Source from a network server at no charge.
-
-    c) Convey individual copies of the object code with a copy of the
-    written offer to provide the Corresponding Source.  This
-    alternative is allowed only occasionally and noncommercially, and
-    only if you received the object code with such an offer, in accord
-    with subsection 6b.
-
-    d) Convey the object code by offering access from a designated
-    place (gratis or for a charge), and offer equivalent access to the
-    Corresponding Source in the same way through the same place at no
-    further charge.  You need not require recipients to copy the
-    Corresponding Source along with the object code.  If the place to
-    copy the object code is a network server, the Corresponding Source
-    may be on a different server (operated by you or a third party)
-    that supports equivalent copying facilities, provided you maintain
-    clear directions next to the object code saying where to find the
-    Corresponding Source.  Regardless of what server hosts the
-    Corresponding Source, you remain obligated to ensure that it is
-    available for as long as needed to satisfy these requirements.
-
-    e) Convey the object code using peer-to-peer transmission, provided
-    you inform other peers where the object code and Corresponding
-    Source of the work are being offered to the general public at no
-    charge under subsection 6d.
-
-  A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
-  A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling.  In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage.  For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product.  A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
-  "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source.  The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
-  If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information.  But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
-  The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed.  Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
-  Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
-  7. Additional Terms.
-
-  "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law.  If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
-  When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it.  (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.)  You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
-  Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
-    a) Disclaiming warranty or limiting liability differently from the
-    terms of sections 15 and 16 of this License; or
-
-    b) Requiring preservation of specified reasonable legal notices or
-    author attributions in that material or in the Appropriate Legal
-    Notices displayed by works containing it; or
-
-    c) Prohibiting misrepresentation of the origin of that material, or
-    requiring that modified versions of such material be marked in
-    reasonable ways as different from the original version; or
-
-    d) Limiting the use for publicity purposes of names of licensors or
-    authors of the material; or
-
-    e) Declining to grant rights under trademark law for use of some
-    trade names, trademarks, or service marks; or
-
-    f) Requiring indemnification of licensors and authors of that
-    material by anyone who conveys the material (or modified versions of
-    it) with contractual assumptions of liability to the recipient, for
-    any liability that these contractual assumptions directly impose on
-    those licensors and authors.
-
-  All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10.  If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term.  If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
-  If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
-  Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
-  8. Termination.
-
-  You may not propagate or modify a covered work except as expressly
-provided under this License.  Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
-  However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
-  Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
-  Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License.  If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
-  9. Acceptance Not Required for Having Copies.
-
-  You are not required to accept this License in order to receive or
-run a copy of the Program.  Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance.  However,
-nothing other than this License grants you permission to propagate or
-modify any covered work.  These actions infringe copyright if you do
-not accept this License.  Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
-  10. Automatic Licensing of Downstream Recipients.
-
-  Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License.  You are not responsible
-for enforcing compliance by third parties with this License.
-
-  An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations.  If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
-  You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License.  For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
-  11. Patents.
-
-  A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based.  The
-work thus licensed is called the contributor's "contributor version".
-
-  A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version.  For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
-  Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
-  In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement).  To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
-  If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients.  "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
-  If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
-  A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License.  You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
-  Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
-  12. No Surrender of Others' Freedom.
-
-  If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License.  If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all.  For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
-  13. Use with the GNU Affero General Public License.
-
-  Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU Affero General Public License into a single
-combined work, and to convey the resulting work.  The terms of this
-License will continue to apply to the part which is the covered work,
-but the special requirements of the GNU Affero General Public License,
-section 13, concerning interaction through a network will apply to the
-combination as such.
-
-  14. Revised Versions of this License.
-
-  The Free Software Foundation may publish revised and/or new versions of
-the GNU General Public License from time to time.  Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-  Each version is given a distinguishing version number.  If the
-Program specifies that a certain numbered version of the GNU General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation.  If the Program does not specify a version number of the
-GNU General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
-  If the Program specifies that a proxy can decide which future
-versions of the GNU General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
-  Later license versions may give you additional or different
-permissions.  However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
-  15. Disclaimer of Warranty.
-
-  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
-  16. Limitation of Liability.
-
-  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
-  17. Interpretation of Sections 15 and 16.
-
-  If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
-              END OF TERMS AND CONDITIONS
-
-     How to Apply These Terms to Your New Programs
-
-  If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
-  To do so, attach the following notices to the program.  It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
-    <one line to give the program's name and a brief idea of what it does.>
-    Copyright (C) <year>  <name of author>
-
-    This program is free software: you can redistribute it and/or modify
-    it under the terms of the GNU General Public License as published by
-    the Free Software Foundation, either version 3 of the License, or
-    (at your option) any later version.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-    GNU General Public License for more details.
-
-    You should have received a copy of the GNU General Public License
-    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
-  If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
-
-    <program>  Copyright (C) <year>  <name of author>
-    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
-    This is free software, and you are welcome to redistribute it
-    under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License.  Of course, your program's commands
-might be different; for a GUI interface, you would use an "about box".
-
-  You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
-
-  The GNU General Public License does not permit incorporating your program
-into proprietary programs.  If your program is a subroutine library, you
-may consider it more useful to permit linking proprietary applications with
-the library.  If this is what you want to do, use the GNU Lesser General
-Public License instead of this License.  But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/users/grfn/xanthous/README.org b/users/grfn/xanthous/README.org
deleted file mode 100644
index 7e1fedb069b1..000000000000
--- a/users/grfn/xanthous/README.org
+++ /dev/null
@@ -1,36 +0,0 @@
-#+TITLE: Xanthous
-
-* Building
-
-#+BEGIN_SRC shell
-$ nix build
-#+END_SRC
-
-* Running
-
-#+BEGIN_SRC shell
-$ ./result/bin/xanthous [--help]
-#+END_SRC
-
-** Keyboard commands
-
-Keyboard commands are currently undocumented, but can be found in [[[https://github.com/glittershark/xanthous/blob/master/src/Xanthous/Command.hs#L26][this file]].
-Movement uses the nethack-esque hjklybnu.
-
-* Development
-
-Use [[https://github.com/target/lorri][lorri]], or run everything in a ~nix-shell~
-
-#+BEGIN_SRC shell
-# Build (for dev)
-$ cabal new-build
-
-# Run the game
-$ cabal new-run xanthous
-
-# Run tests
-$ cabal new-run test
-
-# Run a repl
-$ cabal new-repl
-#+END_SRC
diff --git a/users/grfn/xanthous/Setup.hs b/users/grfn/xanthous/Setup.hs
deleted file mode 100644
index 9a994af677b0..000000000000
--- a/users/grfn/xanthous/Setup.hs
+++ /dev/null
@@ -1,2 +0,0 @@
-import Distribution.Simple
-main = defaultMain
diff --git a/users/grfn/xanthous/app/Main.hs b/users/grfn/xanthous/app/Main.hs
deleted file mode 100644
index c771a0d932cb..000000000000
--- a/users/grfn/xanthous/app/Main.hs
+++ /dev/null
@@ -1,171 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Main ( main ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (finally)
-import           Brick
-import qualified Brick.BChan
-import qualified Graphics.Vty as Vty
-import qualified Options.Applicative as Opt
-import           System.Random
-import           Control.Monad.Random (getRandom)
-import           Control.Exception (finally)
-import           System.Exit (die)
---------------------------------------------------------------------------------
-import qualified Xanthous.Game as Game
-import           Xanthous.Game.Env (GameEnv(..))
-import qualified Xanthous.Game.Env as Game
-import           Xanthous.App
-import           Xanthous.Generators.Level
-                 ( GeneratorInput
-                 , parseGeneratorInput
-                 , generateFromInput
-                 , showCells
-                 )
-import qualified Xanthous.Entities.Character as Character
-import           Xanthous.Generators.Level.Util (regions)
-import           Xanthous.Generators.Level.LevelContents
-import           Xanthous.Data (Dimensions, Dimensions'(Dimensions))
-import           Data.Array.IArray ( amap )
---------------------------------------------------------------------------------
-
-parseGameConfig :: Opt.Parser Game.Config
-parseGameConfig = Game.Config
-  <$> Opt.switch
-      ( Opt.long "disable-saving"
-      <> Opt.help "Disallow saving games"
-      )
-
-data RunParams = RunParams
-  { seed :: Maybe Int
-  , characterName :: Maybe Text
-  , gameConfig :: Game.Config
-  }
-  deriving stock (Show, Eq)
-
-parseRunParams :: Opt.Parser RunParams
-parseRunParams = RunParams
-  <$> optional (Opt.option Opt.auto
-      ( Opt.long "seed"
-      <> Opt.help "Random seed for the game."
-      ))
-  <*> optional (Opt.strOption
-      ( Opt.short 'n'
-      <> Opt.long "name"
-      <> Opt.help
-        ( "Name for the character. If not set on the command line, "
-        <> "will be prompted for at runtime"
-        )
-      ))
-  <*> parseGameConfig
-
-data Command
-  = Run RunParams
-  | Load FilePath
-  | Generate GeneratorInput Dimensions (Maybe Int)
-
-parseDimensions :: Opt.Parser Dimensions
-parseDimensions = Dimensions
-  <$> Opt.option Opt.auto
-       ( Opt.short 'w'
-       <> Opt.long "width"
-       <> Opt.metavar "TILES"
-       )
-  <*> Opt.option Opt.auto
-       ( Opt.short 'h'
-       <> Opt.long "height"
-       <> Opt.metavar "TILES"
-       )
-
-
-parseCommand :: Opt.Parser Command
-parseCommand = (<|> Run <$> parseRunParams) $ Opt.subparser
-  $ Opt.command "run"
-      (Opt.info
-       (Run <$> parseRunParams)
-       (Opt.progDesc "Run the game"))
-  <> Opt.command "load"
-      (Opt.info
-       (Load <$> Opt.argument Opt.str (Opt.metavar "FILE"))
-       (Opt.progDesc "Load a saved game"))
-  <> Opt.command "generate"
-      (Opt.info
-       (Generate
-        <$> parseGeneratorInput
-        <*> parseDimensions
-        <*> optional
-            (Opt.option Opt.auto (Opt.long "seed"))
-        <**> Opt.helper
-       )
-       (Opt.progDesc "Generate a sample level"))
-
-optParser :: Opt.ParserInfo Command
-optParser = Opt.info
-  (parseCommand <**> Opt.helper)
-  (Opt.header "Xanthous: a WIP TUI RPG")
-
-thanks :: IO ()
-thanks = putStr "\n\n" >> putStrLn "Thanks for playing Xanthous!"
-
-newGame :: RunParams -> IO ()
-newGame rparams = do
-  gameSeed <- maybe getRandom pure $ seed rparams
-  when (isNothing $ seed rparams)
-    . putStrLn
-    $ "Seed: " <> tshow gameSeed
-  let initialState = Game.initialStateFromSeed gameSeed &~ do
-        for_ (characterName rparams) $ \cn ->
-          Game.character . Character.characterName ?= cn
-  runGame NewGame (gameConfig rparams) initialState `finally` do
-    thanks
-    when (isNothing $ seed rparams)
-      . putStrLn
-      $ "Seed: " <> tshow gameSeed
-    putStr "\n\n"
-
-loadGame :: FilePath -> IO ()
-loadGame saveFile = do
-  gameState <- maybe (die "Invalid save file!") pure . Game.loadGame  . fromStrict
-              =<< readFile @IO saveFile
-  gameState `deepseq` runGame (LoadGame saveFile) Game.defaultConfig gameState
-
-runGame :: RunType -> Game.Config -> Game.GameState -> IO ()
-runGame rt _config gameState = do
-  _eventChan <- Brick.BChan.newBChan 10
-  let gameEnv = GameEnv {..}
-  app <- makeApp gameEnv rt
-  let buildVty = Vty.mkVty Vty.defaultConfig
-  initialVty <- buildVty
-  _game' <- customMain
-    initialVty
-    buildVty
-    (Just _eventChan)
-    app
-    gameState
-  pure ()
-
-runGenerate :: GeneratorInput -> Dimensions -> Maybe Int -> IO ()
-runGenerate input dims mSeed = do
-  putStrLn "Generating..."
-  genSeed <- maybe getRandom pure mSeed
-  let randGen = mkStdGen genSeed
-      res = generateFromInput input dims randGen
-      rs = regions $ amap not res
-  when (isNothing mSeed)
-    . putStrLn
-    $ "Seed: " <> tshow genSeed
-  putStr "num regions: "
-  print $ length rs
-  putStr "region lengths: "
-  print $ length <$> rs
-  putStr "character position: "
-  print =<< chooseCharacterPosition res
-  putStrLn $ showCells res
-
-runCommand :: Command -> IO ()
-runCommand (Run runParams) = newGame runParams
-runCommand (Load saveFile) = loadGame saveFile
-runCommand (Generate input dims mSeed) = runGenerate input dims mSeed
-
-main :: IO ()
-main = runCommand =<< Opt.execParser optParser
diff --git a/users/grfn/xanthous/bench/Bench.hs b/users/grfn/xanthous/bench/Bench.hs
deleted file mode 100644
index 5889618ee432..000000000000
--- a/users/grfn/xanthous/bench/Bench.hs
+++ /dev/null
@@ -1,12 +0,0 @@
---------------------------------------------------------------------------------
-module Main where
---------------------------------------------------------------------------------
-import Bench.Prelude
---------------------------------------------------------------------------------
-import qualified Xanthous.RandomBench
-import qualified Xanthous.Generators.UtilBench
-
-main :: IO ()
-main = defaultMain
-  [ Xanthous.Generators.UtilBench.benchmark
-  ]
diff --git a/users/grfn/xanthous/bench/Bench/Prelude.hs b/users/grfn/xanthous/bench/Bench/Prelude.hs
deleted file mode 100644
index c553abd6d5d0..000000000000
--- a/users/grfn/xanthous/bench/Bench/Prelude.hs
+++ /dev/null
@@ -1,9 +0,0 @@
---------------------------------------------------------------------------------
-module Bench.Prelude
-  ( module Xanthous.Prelude
-  , module Criterion.Main
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Criterion.Main
---------------------------------------------------------------------------------
diff --git a/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs b/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs
deleted file mode 100644
index 56310e691c33..000000000000
--- a/users/grfn/xanthous/bench/Xanthous/Generators/UtilBench.hs
+++ /dev/null
@@ -1,37 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Generators.UtilBench (benchmark, main) where
---------------------------------------------------------------------------------
-import           Bench.Prelude
---------------------------------------------------------------------------------
-import           Data.Array.IArray
-import           Data.Array.Unboxed
-import           System.Random (getStdGen)
---------------------------------------------------------------------------------
-import           Xanthous.Generators.Util
-import qualified Xanthous.Generators.CaveAutomata as CaveAutomata
-import           Xanthous.Data (Dimensions'(..))
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain [benchmark]
-
---------------------------------------------------------------------------------
-
-benchmark :: Benchmark
-benchmark = bgroup "Generators.Util"
-  [ bgroup "floodFill"
-    [ env (NFWrapper <$> cells) $ \(NFWrapper ir) ->
-        bench "checkerboard" $ nf (floodFill ir) (1,0)
-    ]
-  ]
-  where
-    cells :: IO Cells
-    cells = CaveAutomata.generate
-      CaveAutomata.defaultParams
-      (Dimensions 50 50)
-      <$> getStdGen
-
-newtype NFWrapper a = NFWrapper a
-
-instance NFData (NFWrapper a) where
-  rnf (NFWrapper x) = x `seq` ()
diff --git a/users/grfn/xanthous/bench/Xanthous/RandomBench.hs b/users/grfn/xanthous/bench/Xanthous/RandomBench.hs
deleted file mode 100644
index fae4af92a7a5..000000000000
--- a/users/grfn/xanthous/bench/Xanthous/RandomBench.hs
+++ /dev/null
@@ -1,32 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.RandomBench (benchmark, main) where
---------------------------------------------------------------------------------
-import Bench.Prelude
---------------------------------------------------------------------------------
-import Control.Parallel.Strategies
-import Control.Monad.Random
---------------------------------------------------------------------------------
-import Xanthous.Random
---------------------------------------------------------------------------------
-
-main :: IO ()
-main = defaultMain [benchmark]
-
---------------------------------------------------------------------------------
-
-benchmark :: Benchmark
-benchmark = bgroup "Random"
-  [ bgroup "chooseSubset"
-    [ bench "serially" $
-      nf (evalRand $ chooseSubset (0.5 :: Double) [1 :: Int ..1000000])
-         (mkStdGen 1234)
-    ]
-  , bgroup "choose weightedBy"
-    [ bench "serially" $
-      nf (evalRand
-          . choose
-          . weightedBy (\n -> product [n, pred n .. 1])
-          $ [1 :: Int ..1000000])
-         (mkStdGen 1234)
-    ]
-  ]
diff --git a/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch b/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch
deleted file mode 100644
index f0c936bfca18..000000000000
--- a/users/grfn/xanthous/build/generic-arbitrary-export-garbitrary.patch
+++ /dev/null
@@ -1,12 +0,0 @@
-diff --git a/src/Test/QuickCheck/Arbitrary/Generic.hs b/src/Test/QuickCheck/Arbitrary/Generic.hs
-index fed6ab3..91f59f1 100644
---- a/src/Test/QuickCheck/Arbitrary/Generic.hs
-+++ b/src/Test/QuickCheck/Arbitrary/Generic.hs
-@@ -23,6 +23,7 @@ The generated 'arbitrary' method is equivalent to
- 
- module Test.QuickCheck.Arbitrary.Generic
-   ( Arbitrary(..)
-+  , GArbitrary
-   , genericArbitrary
-   , genericShrink
-   ) where
diff --git a/users/grfn/xanthous/build/hgeometry-fix-haddock.patch b/users/grfn/xanthous/build/hgeometry-fix-haddock.patch
deleted file mode 100644
index 748c65b3e0db..000000000000
--- a/users/grfn/xanthous/build/hgeometry-fix-haddock.patch
+++ /dev/null
@@ -1,13 +0,0 @@
-diff --git a/src/Data/Geometry/PlanarSubdivision/Merge.hs b/src/Data/Geometry/PlanarSubdivision/Merge.hs
-index 1136114..3f4e7bb 100644
---- a/src/Data/Geometry/PlanarSubdivision/Merge.hs
-+++ b/src/Data/Geometry/PlanarSubdivision/Merge.hs
-@@ -153,7 +153,7 @@ mergeWith' mergeFaces p1 p2 = PlanarSubdivision cs vd rd rf
-         -- we have to shift the number of the *Arcs*. Since every dart
-         -- consists of two arcs, we have to shift by numDarts / 2
-         -- Furthermore, we take numFaces - 1 since we want the first
--        -- *internal* face of p2 (the one with FaceId 1) to correspond with the first free
-+        -- /internal/ face of p2 (the one with FaceId 1) to correspond with the first free
-         -- position (at index numFaces)
-
-     cs = p1^.components <> p2'^.components
diff --git a/users/grfn/xanthous/build/update-comonad-extras.patch b/users/grfn/xanthous/build/update-comonad-extras.patch
deleted file mode 100644
index cd1dbe24d361..000000000000
--- a/users/grfn/xanthous/build/update-comonad-extras.patch
+++ /dev/null
@@ -1,92 +0,0 @@
-diff --git a/comonad-extras.cabal b/comonad-extras.cabal
-index fc3745a..77a2f0d 100644
---- a/comonad-extras.cabal
-+++ b/comonad-extras.cabal
-@@ -1,7 +1,7 @@
- name:          comonad-extras
- category:      Control, Comonads
--version:       4.0
-+version:       5.0
- x-revision: 1
- license:       BSD3
- cabal-version: >= 1.6
- license-file:  LICENSE
-@@ -34,8 +34,8 @@ library
-   build-depends:
-     array                >= 0.3   && < 0.6,
--    base                 >= 4     && < 4.7,
--    containers           >= 0.4   && < 0.6,
--    comonad              >= 4     && < 5,
-+    base                 >= 4     && < 5,
-+    containers           >= 0.6   && < 0.7,
-+    comonad              >= 5     && < 6,
-     distributive         >= 0.3.2 && < 1,
--    semigroupoids        >= 4     && < 5,
--    transformers         >= 0.2   && < 0.4
-+    semigroupoids        >= 5     && < 6,
-+    transformers         >= 0.5   && < 0.6
-
-   exposed-modules:
-     Control.Comonad.Store.Zipper
-diff --git a/src/Control/Comonad/Store/Pointer.hs b/src/Control/Comonad/Store/Pointer.hs
-index 5044a1e..8d4c62d 100644
---- a/src/Control/Comonad/Store/Pointer.hs
-+++ b/src/Control/Comonad/Store/Pointer.hs
-@@ -41,7 +41,6 @@ module Control.Comonad.Store.Pointer
-   , module Control.Comonad.Store.Class
-   ) where
-
--import Control.Applicative
- import Control.Comonad
- import Control.Comonad.Hoist.Class
- import Control.Comonad.Trans.Class
-@@ -51,27 +50,8 @@ import Control.Comonad.Env.Class
- import Data.Functor.Identity
- import Data.Functor.Extend
- import Data.Array
--
- #ifdef __GLASGOW_HASKELL__
- import Data.Typeable
--instance (Typeable i, Typeable1 w) => Typeable1 (PointerT i w) where
--  typeOf1 diwa = mkTyConApp storeTTyCon [typeOf (i diwa), typeOf1 (w diwa)]
--    where
--      i :: PointerT i w a -> i
--      i = undefined
--      w :: PointerT i w a -> w a
--      w = undefined
--
--instance (Typeable i, Typeable1 w, Typeable a) => Typeable (PointerT i w a) where
--  typeOf = typeOfDefault
--
--storeTTyCon :: TyCon
--#if __GLASGOW_HASKELL__ < 704
--storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.Pointer.PointerT"
--#else
--storeTTyCon = mkTyCon3 "comonad-extras" "Control.Comonad.Trans.Store.Pointer" "PointerT"
--#endif
--{-# NOINLINE storeTTyCon #-}
- #endif
-
- type Pointer i = PointerT i Identity
-@@ -83,6 +63,9 @@ runPointer :: Pointer i a -> (Array i a, i)
- runPointer (PointerT (Identity f) i) = (f, i)
-
- data PointerT i w a = PointerT (w (Array i a)) i
-+#ifdef __GLASGOW_HASKELL__
-+  deriving Typeable
-+#endif
-
- runPointerT :: PointerT i w a -> (w (Array i a), i)
- runPointerT (PointerT g i) = (g, i)
-diff --git a/src/Control/Comonad/Store/Zipper.hs b/src/Control/Comonad/Store/Zipper.hs
-index 3b70c86..decc378 100644
---- a/src/Control/Comonad/Store/Zipper.hs
-+++ b/src/Control/Comonad/Store/Zipper.hs
-@@ -15,7 +15,6 @@
- module Control.Comonad.Store.Zipper
-   ( Zipper, zipper, zipper1, unzipper, size) where
-
--import Control.Applicative
- import Control.Comonad (Comonad(..))
- import Data.Functor.Extend
- import Data.Foldable
diff --git a/users/grfn/xanthous/default.nix b/users/grfn/xanthous/default.nix
deleted file mode 100644
index 049c92fb4c9c..000000000000
--- a/users/grfn/xanthous/default.nix
+++ /dev/null
@@ -1,27 +0,0 @@
-{ depot ? (import ../../../. { })
-, pkgs ? depot.third_party.nixpkgs
-, ...
-}:
-
-let
-  ignore = depot.third_party.gitignoreSource.gitignoreFilter ./.;
-  src = builtins.path {
-    name = "xanthous-source";
-    path = ./.;
-    filter = path: type:
-      !(type == "directory" && builtins.baseNameOf path == "server")
-      && !(type == "directory" && builtins.baseNameOf path == "docs")
-      && (ignore path type
-      || builtins.baseNameOf path == "package.yaml");
-  };
-  # generated by cabal2nix
-  basePkg = pkgs.haskell.packages.ghc8107.callPackage ./pkg.nix { };
-in
-
-pkgs.haskell.lib.overrideCabal basePkg (default: {
-  inherit src;
-  version = "canon";
-  configureFlags = [
-    "--ghc-option=-Wall --ghc-option=-Werror"
-  ] ++ (default.configureFlags or [ ]);
-})
diff --git a/users/grfn/xanthous/docs/raw-types.org b/users/grfn/xanthous/docs/raw-types.org
deleted file mode 100644
index e5bcda04268f..000000000000
--- a/users/grfn/xanthous/docs/raw-types.org
+++ /dev/null
@@ -1,24 +0,0 @@
-#+TITLE: Raw Types (WIP)
-
-
-* Raw Types
-** Item
-*** Attributes
-| name            | type                      | commentary                                                       |
-|-----------------+---------------------------+------------------------------------------------------------------|
-| name            | string                    |                                                                  |
-| description     | string                    | Not capitalized, should usually start with an indefinite article |
-| longDescription | string                    | Capitalized, should usually start with an indefinite article     |
-| char            | [[*EntityChar][EntityChar]]                |                                                                  |
-| wieldable       | [[*EntityWieldable][EntityWieldable]]           |                                                                  |
-| density         | number , [number, number] | Density, or range for random density, in g/m³                    |
-| volume          | number , [number, number] | Volume, or range for random volume, in m³                        |
-* Data Types
-** EntityChar
-*** Attributes
-| name  | type | commentary                                            |
-|-------+------+-------------------------------------------------------|
-| char  | char | How the entity is displayed when dropped on the floor |
-| style | Attr |                                                       |
-** TODO EntityWieldable
-** TODO Attr
diff --git a/users/grfn/xanthous/hie.yaml b/users/grfn/xanthous/hie.yaml
deleted file mode 100644
index e7cf01d158e5..000000000000
--- a/users/grfn/xanthous/hie.yaml
+++ /dev/null
@@ -1,10 +0,0 @@
-cradle:
-  cabal:
-    - path: './src'
-      component: 'lib:xanthous'
-    - path: './test'
-      component: 'test:test'
-    - path: './app'
-      component: 'exe:xanthous'
-    - path: './bench'
-      component: 'bench:benchmark'
diff --git a/users/grfn/xanthous/nixpkgs.nix b/users/grfn/xanthous/nixpkgs.nix
deleted file mode 100644
index 7d7c16440545..000000000000
--- a/users/grfn/xanthous/nixpkgs.nix
+++ /dev/null
@@ -1,3 +0,0 @@
-args:
-let pkgs = (import ../../../. args).third_party;
-in pkgs // { inherit pkgs; }
diff --git a/users/grfn/xanthous/package.yaml b/users/grfn/xanthous/package.yaml
deleted file mode 100644
index 15a36fe964be..000000000000
--- a/users/grfn/xanthous/package.yaml
+++ /dev/null
@@ -1,157 +0,0 @@
-name:                xanthous
-version:             0.1.0.0
-github:              "glittershark/xanthous"
-license:             GPL-3
-author:              "Griffin Smith"
-maintainer:          "root@gws.fyi"
-copyright:           "2019 Griffin Smith"
-
-extra-source-files:
-- README.org
-
-synopsis:            A WIP TUI RPG
-category:            Game
-
-description:         Please see the README on GitHub at <https://github.com/glittershark/xanthous>
-
-dependencies:
-- base
-
-- aeson
-- array
-- async
-- QuickCheck
-- quickcheck-text
-- quickcheck-instances
-- brick
-- bifunctors
-- checkers
-- classy-prelude
-- comonad
-- comonad-extras
-- constraints
-- containers
-- criterion
-- data-default
-- data-interval
-- deepseq
-- directory
-- fgl
-- fgl-arbitrary
-- file-embed
-- filepath
-- generic-arbitrary
-- generic-lens
-- groups
-- hgeometry
-- hgeometry-combinatorial
-- JuicyPixels
-- lens
-- lifted-async
-- linear
-- megaparsec
-- mmorph
-- monad-control
-- MonadRandom
-- mtl
-- optparse-applicative
-- parallel
-- parser-combinators
-- pointed
-- random
-- random-fu
-- random-extras
-- random-source
-- raw-strings-qq
-- reflection
-- Rasterific
-- splitmix
-- streams
-- stache
-- semigroups
-- semigroupoids
-- tomland
-- transformers
-- text
-- text-zipper
-- vector
-- vty
-- witherable
-- yaml
-- zlib
-
-default-extensions:
-- BlockArguments
-- ConstraintKinds
-- DataKinds
-- DeriveAnyClass
-- DeriveGeneric
-- DerivingStrategies
-- DerivingVia
-- FlexibleContexts
-- FlexibleInstances
-- FunctionalDependencies
-- GADTSyntax
-- GeneralizedNewtypeDeriving
-- KindSignatures
-- StandaloneKindSignatures
-- LambdaCase
-- MultiWayIf
-- NoImplicitPrelude
-- NoStarIsType
-- OverloadedStrings
-- PolyKinds
-- RankNTypes
-- ScopedTypeVariables
-- TupleSections
-- TypeApplications
-- TypeFamilies
-- TypeOperators
-- ViewPatterns
-
-ghc-options:
-- -Wall
-- -fconstraint-solver-iterations=6 # Xanthous.Data, Xanthous.Command
-
-library:
-  source-dirs: src
-
-executable:
-  source-dirs: app
-  main: Main.hs
-  dependencies:
-  - xanthous
-  ghc-options:
-  - -threaded
-  - -rtsopts
-  - -with-rtsopts=-N
-  - -O2
-
-tests:
-  test:
-    main:                Spec.hs
-    source-dirs:         test
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    - -O0
-    dependencies:
-    - xanthous
-    - tasty
-    - tasty-hunit
-    - tasty-quickcheck
-    - tasty-rerun
-    - lens-properties
-
-benchmarks:
-  benchmark:
-    main: Bench.hs
-    source-dirs: bench
-    ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
-    dependencies:
-    - xanthous
-    - criterion
diff --git a/users/grfn/xanthous/pkg.nix b/users/grfn/xanthous/pkg.nix
deleted file mode 100644
index f8364c467abe..000000000000
--- a/users/grfn/xanthous/pkg.nix
+++ /dev/null
@@ -1,349 +0,0 @@
-{ mkDerivation
-, aeson
-, array
-, async
-, base
-, bifunctors
-, brick
-, checkers
-, classy-prelude
-, comonad
-, comonad-extras
-, constraints
-, containers
-, criterion
-, data-default
-, data-interval
-, deepseq
-, directory
-, fgl
-, fgl-arbitrary
-, file-embed
-, filepath
-, generic-arbitrary
-, generic-lens
-, groups
-, hgeometry
-, hgeometry-combinatorial
-, hpack
-, JuicyPixels
-, lens
-, lens-properties
-, lib
-, lifted-async
-, linear
-, megaparsec
-, mmorph
-, monad-control
-, MonadRandom
-, mtl
-, optparse-applicative
-, parallel
-, parser-combinators
-, pointed
-, QuickCheck
-, quickcheck-instances
-, quickcheck-text
-, random
-, random-extras
-, random-fu
-, random-source
-, Rasterific
-, raw-strings-qq
-, reflection
-, semigroupoids
-, semigroups
-, splitmix
-, stache
-, streams
-, tasty
-, tasty-hunit
-, tasty-quickcheck
-, tasty-rerun
-, text
-, text-zipper
-, tomland
-, transformers
-, vector
-, vty
-, witherable
-, yaml
-, zlib
-}:
-mkDerivation {
-  pname = "xanthous";
-  version = "0.1.0.0";
-  src = ./.;
-  isLibrary = true;
-  isExecutable = true;
-  libraryHaskellDepends = [
-    aeson
-    array
-    async
-    base
-    bifunctors
-    brick
-    checkers
-    classy-prelude
-    comonad
-    comonad-extras
-    constraints
-    containers
-    criterion
-    data-default
-    data-interval
-    deepseq
-    directory
-    fgl
-    fgl-arbitrary
-    file-embed
-    filepath
-    generic-arbitrary
-    generic-lens
-    groups
-    hgeometry
-    hgeometry-combinatorial
-    JuicyPixels
-    lens
-    lifted-async
-    linear
-    megaparsec
-    mmorph
-    monad-control
-    MonadRandom
-    mtl
-    optparse-applicative
-    parallel
-    parser-combinators
-    pointed
-    QuickCheck
-    quickcheck-instances
-    quickcheck-text
-    random
-    random-extras
-    random-fu
-    random-source
-    Rasterific
-    raw-strings-qq
-    reflection
-    semigroupoids
-    semigroups
-    splitmix
-    stache
-    streams
-    text
-    text-zipper
-    tomland
-    transformers
-    vector
-    vty
-    witherable
-    yaml
-    zlib
-  ];
-  libraryToolDepends = [ hpack ];
-  executableHaskellDepends = [
-    aeson
-    array
-    async
-    base
-    bifunctors
-    brick
-    checkers
-    classy-prelude
-    comonad
-    comonad-extras
-    constraints
-    containers
-    criterion
-    data-default
-    data-interval
-    deepseq
-    directory
-    fgl
-    fgl-arbitrary
-    file-embed
-    filepath
-    generic-arbitrary
-    generic-lens
-    groups
-    hgeometry
-    hgeometry-combinatorial
-    JuicyPixels
-    lens
-    lifted-async
-    linear
-    megaparsec
-    mmorph
-    monad-control
-    MonadRandom
-    mtl
-    optparse-applicative
-    parallel
-    parser-combinators
-    pointed
-    QuickCheck
-    quickcheck-instances
-    quickcheck-text
-    random
-    random-extras
-    random-fu
-    random-source
-    Rasterific
-    raw-strings-qq
-    reflection
-    semigroupoids
-    semigroups
-    splitmix
-    stache
-    streams
-    text
-    text-zipper
-    tomland
-    transformers
-    vector
-    vty
-    witherable
-    yaml
-    zlib
-  ];
-  testHaskellDepends = [
-    aeson
-    array
-    async
-    base
-    bifunctors
-    brick
-    checkers
-    classy-prelude
-    comonad
-    comonad-extras
-    constraints
-    containers
-    criterion
-    data-default
-    data-interval
-    deepseq
-    directory
-    fgl
-    fgl-arbitrary
-    file-embed
-    filepath
-    generic-arbitrary
-    generic-lens
-    groups
-    hgeometry
-    hgeometry-combinatorial
-    JuicyPixels
-    lens
-    lens-properties
-    lifted-async
-    linear
-    megaparsec
-    mmorph
-    monad-control
-    MonadRandom
-    mtl
-    optparse-applicative
-    parallel
-    parser-combinators
-    pointed
-    QuickCheck
-    quickcheck-instances
-    quickcheck-text
-    random
-    random-extras
-    random-fu
-    random-source
-    Rasterific
-    raw-strings-qq
-    reflection
-    semigroupoids
-    semigroups
-    splitmix
-    stache
-    streams
-    tasty
-    tasty-hunit
-    tasty-quickcheck
-    tasty-rerun
-    text
-    text-zipper
-    tomland
-    transformers
-    vector
-    vty
-    witherable
-    yaml
-    zlib
-  ];
-  benchmarkHaskellDepends = [
-    aeson
-    array
-    async
-    base
-    bifunctors
-    brick
-    checkers
-    classy-prelude
-    comonad
-    comonad-extras
-    constraints
-    containers
-    criterion
-    data-default
-    data-interval
-    deepseq
-    directory
-    fgl
-    fgl-arbitrary
-    file-embed
-    filepath
-    generic-arbitrary
-    generic-lens
-    groups
-    hgeometry
-    hgeometry-combinatorial
-    JuicyPixels
-    lens
-    lifted-async
-    linear
-    megaparsec
-    mmorph
-    monad-control
-    MonadRandom
-    mtl
-    optparse-applicative
-    parallel
-    parser-combinators
-    pointed
-    QuickCheck
-    quickcheck-instances
-    quickcheck-text
-    random
-    random-extras
-    random-fu
-    random-source
-    Rasterific
-    raw-strings-qq
-    reflection
-    semigroupoids
-    semigroups
-    splitmix
-    stache
-    streams
-    text
-    text-zipper
-    tomland
-    transformers
-    vector
-    vty
-    witherable
-    yaml
-    zlib
-  ];
-  prePatch = "hpack";
-  homepage = "https://github.com/glittershark/xanthous#readme";
-  description = "A WIP TUI RPG";
-  license = lib.licenses.gpl3Only;
-}
diff --git a/users/grfn/xanthous/server/.envrc b/users/grfn/xanthous/server/.envrc
deleted file mode 100644
index 051d09d292a8..000000000000
--- a/users/grfn/xanthous/server/.envrc
+++ /dev/null
@@ -1 +0,0 @@
-eval "$(lorri direnv)"
diff --git a/users/grfn/xanthous/server/.gitignore b/users/grfn/xanthous/server/.gitignore
deleted file mode 100644
index 2f7896d1d136..000000000000
--- a/users/grfn/xanthous/server/.gitignore
+++ /dev/null
@@ -1 +0,0 @@
-target/
diff --git a/users/grfn/xanthous/server/Cargo.lock b/users/grfn/xanthous/server/Cargo.lock
deleted file mode 100644
index 173298b158c1..000000000000
--- a/users/grfn/xanthous/server/Cargo.lock
+++ /dev/null
@@ -1,1874 +0,0 @@
-# This file is automatically @generated by Cargo.
-# It is not intended for manual editing.
-version = 3
-
-[[package]]
-name = "addr2line"
-version = "0.17.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b9ecd88a8c8378ca913a680cd98f0f13ac67383d35993f86c90a70e3f137816b"
-dependencies = [
- "gimli",
-]
-
-[[package]]
-name = "adler"
-version = "1.0.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f26201604c87b1e01bd3d98f8d5d9a8fcbb815e8cedb41ffccbeb4bf593a35fe"
-
-[[package]]
-name = "aes"
-version = "0.7.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9e8b47f52ea9bae42228d07ec09eb676433d7c4ed1ebdf0f1d1c29ed446f1ab8"
-dependencies = [
- "cfg-if",
- "cipher",
- "cpufeatures",
- "ctr",
- "opaque-debug",
-]
-
-[[package]]
-name = "ahash"
-version = "0.7.6"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "fcb51a0695d8f838b1ee009b3fbf66bda078cd64590202a864a8f3e8c4315c47"
-dependencies = [
- "getrandom",
- "once_cell",
- "version_check",
-]
-
-[[package]]
-name = "aho-corasick"
-version = "0.7.19"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b4f55bd91a0978cbfd91c457a164bab8b4001c833b7f323132c0a4e1922dd44e"
-dependencies = [
- "memchr",
-]
-
-[[package]]
-name = "android_system_properties"
-version = "0.1.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "819e7219dbd41043ac279b19830f2efc897156490d7fd6ea916720117ee66311"
-dependencies = [
- "libc",
-]
-
-[[package]]
-name = "ansi_term"
-version = "0.12.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d52a9bb7ec0cf484c551830a7ce27bd20d67eac647e1befb56b0be4ee39a55d2"
-dependencies = [
- "winapi",
-]
-
-[[package]]
-name = "atomic-shim"
-version = "0.2.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "67cd4b51d303cf3501c301e8125df442128d3c6d7c69f71b27833d253de47e77"
-dependencies = [
- "crossbeam-utils",
-]
-
-[[package]]
-name = "atty"
-version = "0.2.14"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d9b39be18770d11421cdb1b9947a45dd3f37e93092cbf377614828a319d5fee8"
-dependencies = [
- "hermit-abi",
- "libc",
- "winapi",
-]
-
-[[package]]
-name = "autocfg"
-version = "1.1.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d468802bab17cbc0cc575e9b053f41e72aa36bfa6b7f55e3529ffa43161b97fa"
-
-[[package]]
-name = "backtrace"
-version = "0.3.66"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "cab84319d616cfb654d03394f38ab7e6f0919e181b1b57e1fd15e7fb4077d9a7"
-dependencies = [
- "addr2line",
- "cc",
- "cfg-if",
- "libc",
- "miniz_oxide",
- "object",
- "rustc-demangle",
-]
-
-[[package]]
-name = "base64ct"
-version = "1.1.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e6b4d9b1225d28d360ec6a231d65af1fd99a2a095154c8040689617290569c5c"
-
-[[package]]
-name = "bcrypt-pbkdf"
-version = "0.6.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7c38c03b9506bd92bf1ef50665a81eda156f615438f7654bffba58907e6149d7"
-dependencies = [
- "blowfish",
- "crypto-mac",
- "pbkdf2",
- "sha2",
- "zeroize",
-]
-
-[[package]]
-name = "bit-vec"
-version = "0.6.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "349f9b6a179ed607305526ca489b34ad0a41aed5f7980fa90eb03160b69598fb"
-
-[[package]]
-name = "bitflags"
-version = "1.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bef38d45163c2f1dde094a7dfd33ccf595c92905c8f8f4fdc18d06fb1037718a"
-
-[[package]]
-name = "block-buffer"
-version = "0.9.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4152116fd6e9dadb291ae18fc1ec3575ed6d84c29642d97890f4b4a3417297e4"
-dependencies = [
- "generic-array",
-]
-
-[[package]]
-name = "block-modes"
-version = "0.8.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2cb03d1bed155d89dce0f845b7899b18a9a163e148fd004e1c28421a783e2d8e"
-dependencies = [
- "block-padding",
- "cipher",
-]
-
-[[package]]
-name = "block-padding"
-version = "0.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8d696c370c750c948ada61c69a0ee2cbbb9c50b1019ddb86d9317157a99c2cae"
-
-[[package]]
-name = "blowfish"
-version = "0.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "fe3ff3fc1de48c1ac2e3341c4df38b0d1bfb8fdf04632a187c8b75aaa319a7ab"
-dependencies = [
- "byteorder",
- "cipher",
- "opaque-debug",
-]
-
-[[package]]
-name = "bumpalo"
-version = "3.11.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c1ad822118d20d2c234f427000d5acc36eabe1e29a348c89b63dd60b13f28e5d"
-
-[[package]]
-name = "byteorder"
-version = "1.4.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "14c189c53d098945499cdfa7ecc63567cf3886b3332b312a5b4585d8d3a6a610"
-
-[[package]]
-name = "bytes"
-version = "1.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ec8a7b6a70fde80372154c65702f00a0f56f3e1c36abbc6c440484be248856db"
-
-[[package]]
-name = "cc"
-version = "1.0.73"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2fff2a6927b3bb87f9595d67196a70493f627687a71d87a0d692242c33f58c11"
-
-[[package]]
-name = "cfg-if"
-version = "1.0.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "baf1de4339761588bc0619e3cbc0120ee582ebb74b53b4efbf79117bd2da40fd"
-
-[[package]]
-name = "chrono"
-version = "0.4.22"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bfd4d1b31faaa3a89d7934dbded3111da0d2ef28e3ebccdb4f0179f5929d1ef1"
-dependencies = [
- "iana-time-zone",
- "num-integer",
- "num-traits",
- "winapi",
-]
-
-[[package]]
-name = "cipher"
-version = "0.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7ee52072ec15386f770805afd189a01c8841be8696bed250fa2f13c4c0d6dfb7"
-dependencies = [
- "generic-array",
-]
-
-[[package]]
-name = "clap"
-version = "3.2.22"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "86447ad904c7fb335a790c9d7fe3d0d971dc523b8ccd1561a520de9a85302750"
-dependencies = [
- "atty",
- "bitflags",
- "clap_derive",
- "clap_lex",
- "indexmap",
- "once_cell",
- "strsim",
- "termcolor",
- "textwrap",
-]
-
-[[package]]
-name = "clap_derive"
-version = "3.2.18"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ea0c8bce528c4be4da13ea6fead8965e95b6073585a2f05204bd8f4119f82a65"
-dependencies = [
- "heck",
- "proc-macro-error",
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "clap_lex"
-version = "0.2.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2850f2f5a82cbf437dd5af4d49848fbdfc27c157c3d010345776f952765261c5"
-dependencies = [
- "os_str_bytes",
-]
-
-[[package]]
-name = "color-eyre"
-version = "0.5.11"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1f1885697ee8a177096d42f158922251a41973117f6d8a234cee94b9509157b7"
-dependencies = [
- "backtrace",
- "color-spantrace",
- "eyre",
- "indenter",
- "once_cell",
- "owo-colors",
- "tracing-error",
-]
-
-[[package]]
-name = "color-spantrace"
-version = "0.1.6"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b6eee477a4a8a72f4addd4de416eb56d54bc307b284d6601bafdee1f4ea462d1"
-dependencies = [
- "once_cell",
- "owo-colors",
- "tracing-core",
- "tracing-error",
-]
-
-[[package]]
-name = "core-foundation-sys"
-version = "0.8.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5827cebf4670468b8772dd191856768aedcb1b0278a04f989f7766351917b9dc"
-
-[[package]]
-name = "cpufeatures"
-version = "0.2.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "28d997bd5e24a5928dd43e46dc529867e207907fe0b239c3477d924f7f2ca320"
-dependencies = [
- "libc",
-]
-
-[[package]]
-name = "crc32fast"
-version = "1.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b540bd8bc810d3885c6ea91e2018302f68baba2129ab3e88f32389ee9370880d"
-dependencies = [
- "cfg-if",
-]
-
-[[package]]
-name = "crossbeam-epoch"
-version = "0.9.11"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f916dfc5d356b0ed9dae65f1db9fc9770aa2851d2662b988ccf4fe3516e86348"
-dependencies = [
- "autocfg",
- "cfg-if",
- "crossbeam-utils",
- "memoffset",
- "scopeguard",
-]
-
-[[package]]
-name = "crossbeam-utils"
-version = "0.8.12"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "edbafec5fa1f196ca66527c1b12c2ec4745ca14b50f1ad8f9f6f720b55d11fac"
-dependencies = [
- "cfg-if",
-]
-
-[[package]]
-name = "crypto-mac"
-version = "0.11.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b1d1a86f49236c215f271d40892d5fc950490551400b02ef360692c29815c714"
-dependencies = [
- "generic-array",
- "subtle",
-]
-
-[[package]]
-name = "cryptovec"
-version = "0.6.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ccc7fa13a6bbb2322d325292c57f4c8e7291595506f8289968a0eb61c3130bdf"
-dependencies = [
- "libc",
- "winapi",
-]
-
-[[package]]
-name = "ctr"
-version = "0.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "049bb91fb4aaf0e3c7efa6cd5ef877dbbbd15b39dad06d9948de4ec8a75761ea"
-dependencies = [
- "cipher",
-]
-
-[[package]]
-name = "dashmap"
-version = "4.0.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e77a43b28d0668df09411cb0bc9a8c2adc40f9a048afe863e05fd43251e8e39c"
-dependencies = [
- "cfg-if",
- "num_cpus",
-]
-
-[[package]]
-name = "data-encoding"
-version = "2.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "3ee2393c4a91429dffb4bedf19f4d6abf27d8a732c8ce4980305d782e5426d57"
-
-[[package]]
-name = "digest"
-version = "0.9.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d3dd60d1080a57a05ab032377049e0591415d2b31afd7028356dbf3cc6dcb066"
-dependencies = [
- "generic-array",
-]
-
-[[package]]
-name = "dirs"
-version = "3.0.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "30baa043103c9d0c2a57cf537cc2f35623889dc0d405e6c3cccfadbc81c71309"
-dependencies = [
- "dirs-sys",
-]
-
-[[package]]
-name = "dirs-sys"
-version = "0.3.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1b1d1d91c932ef41c0f2663aa8b0ca0342d444d842c06914aa0a7e352d0bada6"
-dependencies = [
- "libc",
- "redox_users",
- "winapi",
-]
-
-[[package]]
-name = "endian-type"
-version = "0.1.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c34f04666d835ff5d62e058c3995147c06f42fe86ff053337632bca83e42702d"
-
-[[package]]
-name = "eyre"
-version = "0.6.8"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4c2b6b5a29c02cdc822728b7d7b8ae1bab3e3b05d44522770ddd49722eeac7eb"
-dependencies = [
- "indenter",
- "once_cell",
-]
-
-[[package]]
-name = "fastrand"
-version = "1.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a7a407cfaa3385c4ae6b23e84623d48c2798d06e3e6a1878f7f59f17b3f86499"
-dependencies = [
- "instant",
-]
-
-[[package]]
-name = "flate2"
-version = "1.0.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f82b0f4c27ad9f8bfd1f3208d882da2b09c301bc1c828fd3a00d0216d2fbbff6"
-dependencies = [
- "crc32fast",
- "miniz_oxide",
-]
-
-[[package]]
-name = "fnv"
-version = "1.0.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1"
-
-[[package]]
-name = "futures"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7f21eda599937fba36daeb58a22e8f5cee2d14c4a17b5b7739c7c8e5e3b8230c"
-dependencies = [
- "futures-channel",
- "futures-core",
- "futures-executor",
- "futures-io",
- "futures-sink",
- "futures-task",
- "futures-util",
-]
-
-[[package]]
-name = "futures-channel"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "30bdd20c28fadd505d0fd6712cdfcb0d4b5648baf45faef7f852afb2399bb050"
-dependencies = [
- "futures-core",
- "futures-sink",
-]
-
-[[package]]
-name = "futures-core"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4e5aa3de05362c3fb88de6531e6296e85cde7739cccad4b9dfeeb7f6ebce56bf"
-
-[[package]]
-name = "futures-executor"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9ff63c23854bee61b6e9cd331d523909f238fc7636290b96826e9cfa5faa00ab"
-dependencies = [
- "futures-core",
- "futures-task",
- "futures-util",
-]
-
-[[package]]
-name = "futures-io"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bbf4d2a7a308fd4578637c0b17c7e1c7ba127b8f6ba00b29f717e9655d85eb68"
-
-[[package]]
-name = "futures-macro"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "42cd15d1c7456c04dbdf7e88bcd69760d74f3a798d6444e16974b505b0e62f17"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "futures-sink"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "21b20ba5a92e727ba30e72834706623d94ac93a725410b6a6b6fbc1b07f7ba56"
-
-[[package]]
-name = "futures-task"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a6508c467c73851293f390476d4491cf4d227dbabcd4170f3bb6044959b294f1"
-
-[[package]]
-name = "futures-util"
-version = "0.3.24"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "44fb6cb1be61cc1d2e43b262516aafcf63b241cffdb1d3fa115f91d9c7b09c90"
-dependencies = [
- "futures-channel",
- "futures-core",
- "futures-io",
- "futures-macro",
- "futures-sink",
- "futures-task",
- "memchr",
- "pin-project-lite",
- "pin-utils",
- "slab",
-]
-
-[[package]]
-name = "generic-array"
-version = "0.14.6"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bff49e947297f3312447abdca79f45f4738097cc82b06e72054d2223f601f1b9"
-dependencies = [
- "typenum",
- "version_check",
-]
-
-[[package]]
-name = "getrandom"
-version = "0.2.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4eb1a864a501629691edf6c15a593b7a51eebaa1e8468e9ddc623de7c9b58ec6"
-dependencies = [
- "cfg-if",
- "libc",
- "wasi 0.11.0+wasi-snapshot-preview1",
-]
-
-[[package]]
-name = "gimli"
-version = "0.26.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "22030e2c5a68ec659fde1e949a745124b48e6fa8b045b7ed5bd1fe4ccc5c4e5d"
-
-[[package]]
-name = "hashbrown"
-version = "0.11.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ab5ef0d4909ef3724cc8cce6ccc8572c5c817592e9285f5464f8e86f8bd3726e"
-dependencies = [
- "ahash",
-]
-
-[[package]]
-name = "hashbrown"
-version = "0.12.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888"
-
-[[package]]
-name = "heck"
-version = "0.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2540771e65fc8cb83cd6e8a237f70c319bd5c29f78ed1084ba5d50eeac86f7f9"
-
-[[package]]
-name = "hermit-abi"
-version = "0.1.19"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "62b467343b94ba476dcb2500d242dadbb39557df889310ac77c5d99100aaac33"
-dependencies = [
- "libc",
-]
-
-[[package]]
-name = "hmac"
-version = "0.11.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2a2a2320eb7ec0ebe8da8f744d7812d9fc4cb4d09344ac01898dbcb6a20ae69b"
-dependencies = [
- "crypto-mac",
- "digest",
-]
-
-[[package]]
-name = "http"
-version = "0.2.8"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "75f43d41e26995c17e71ee126451dd3941010b0514a81a9d11f3b341debc2399"
-dependencies = [
- "bytes",
- "fnv",
- "itoa",
-]
-
-[[package]]
-name = "http-body"
-version = "0.4.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d5f38f16d184e36f2408a55281cd658ecbd3ca05cce6d6510a176eca393e26d1"
-dependencies = [
- "bytes",
- "http",
- "pin-project-lite",
-]
-
-[[package]]
-name = "httparse"
-version = "1.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d897f394bad6a705d5f4104762e116a75639e470d80901eed05a860a95cb1904"
-
-[[package]]
-name = "httpdate"
-version = "1.0.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c4a1e36c821dbe04574f602848a19f742f4fb3c98d40449f11bcad18d6b17421"
-
-[[package]]
-name = "hyper"
-version = "0.14.20"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "02c929dc5c39e335a03c405292728118860721b10190d98c2a0f0efd5baafbac"
-dependencies = [
- "bytes",
- "futures-channel",
- "futures-core",
- "futures-util",
- "http",
- "http-body",
- "httparse",
- "httpdate",
- "itoa",
- "pin-project-lite",
- "socket2",
- "tokio",
- "tower-service",
- "tracing",
- "want",
-]
-
-[[package]]
-name = "iana-time-zone"
-version = "0.1.50"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "fd911b35d940d2bd0bea0f9100068e5b97b51a1cbe13d13382f132e0365257a0"
-dependencies = [
- "android_system_properties",
- "core-foundation-sys",
- "js-sys",
- "wasm-bindgen",
- "winapi",
-]
-
-[[package]]
-name = "indenter"
-version = "0.3.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ce23b50ad8242c51a442f3ff322d56b02f08852c77e4c0b4d3fd684abc89c683"
-
-[[package]]
-name = "indexmap"
-version = "1.9.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "10a35a97730320ffe8e2d410b5d3b69279b98d2c14bdb8b70ea89ecf7888d41e"
-dependencies = [
- "autocfg",
- "hashbrown 0.12.3",
-]
-
-[[package]]
-name = "instant"
-version = "0.1.12"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7a5bbe824c507c5da5956355e86a746d82e0e1464f65d862cc5e71da70e94b2c"
-dependencies = [
- "cfg-if",
-]
-
-[[package]]
-name = "ipnet"
-version = "2.5.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "879d54834c8c76457ef4293a689b2a8c59b076067ad77b15efafbb05f92a592b"
-
-[[package]]
-name = "itoa"
-version = "1.0.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "6c8af84674fe1f223a982c933a0ee1086ac4d4052aa0fb8060c12c6ad838e754"
-
-[[package]]
-name = "js-sys"
-version = "0.3.60"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "49409df3e3bf0856b916e2ceaca09ee28e6871cf7d9ce97a692cacfdb2a25a47"
-dependencies = [
- "wasm-bindgen",
-]
-
-[[package]]
-name = "lazy_static"
-version = "1.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e2abad23fbc42b3700f2f279844dc832adb2b2eb069b2df918f455c4e18cc646"
-
-[[package]]
-name = "libc"
-version = "0.2.134"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "329c933548736bc49fd575ee68c89e8be4d260064184389a5b77517cddd99ffb"
-
-[[package]]
-name = "libsodium-sys"
-version = "0.2.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "6b779387cd56adfbc02ea4a668e704f729be8d6a6abd2c27ca5ee537849a92fd"
-dependencies = [
- "cc",
- "libc",
- "pkg-config",
- "walkdir",
-]
-
-[[package]]
-name = "lock_api"
-version = "0.4.9"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "435011366fe56583b16cf956f9df0095b405b82d76425bc8981c0e22e60ec4df"
-dependencies = [
- "autocfg",
- "scopeguard",
-]
-
-[[package]]
-name = "log"
-version = "0.4.17"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "abb12e687cfb44aa40f41fc3978ef76448f9b6038cad6aef4259d3c095a2382e"
-dependencies = [
- "cfg-if",
-]
-
-[[package]]
-name = "mach"
-version = "0.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b823e83b2affd8f40a9ee8c29dbc56404c1e34cd2710921f2801e2cf29527afa"
-dependencies = [
- "libc",
-]
-
-[[package]]
-name = "matchers"
-version = "0.0.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f099785f7595cc4b4553a174ce30dd7589ef93391ff414dbb67f62392b9e0ce1"
-dependencies = [
- "regex-automata",
-]
-
-[[package]]
-name = "md5"
-version = "0.7.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "490cc448043f947bae3cbee9c203358d62dbee0db12107a74be5c30ccfd09771"
-
-[[package]]
-name = "memchr"
-version = "2.5.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2dffe52ecf27772e601905b7522cb4ef790d2cc203488bbd0e2fe85fcb74566d"
-
-[[package]]
-name = "memoffset"
-version = "0.6.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5aa361d4faea93603064a027415f07bd8e1d5c88c9fbf68bf56a285428fd79ce"
-dependencies = [
- "autocfg",
-]
-
-[[package]]
-name = "metrics"
-version = "0.17.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "55586aa936c35f34ba8aa5d97356d554311206e1ce1f9e68fe7b07288e5ad827"
-dependencies = [
- "ahash",
- "metrics-macros",
-]
-
-[[package]]
-name = "metrics-exporter-prometheus"
-version = "0.6.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "343a5ceb38235928e7a5687412590f07e6d281522dcd9ff51246f8856eef5fe5"
-dependencies = [
- "hyper",
- "ipnet",
- "metrics",
- "metrics-util",
- "parking_lot",
- "quanta",
- "thiserror",
- "tokio",
-]
-
-[[package]]
-name = "metrics-macros"
-version = "0.4.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "0daa0ab3a0ae956d0e2c1f42511422850e577d36a255357d1a7d08d45ee3a2f1"
-dependencies = [
- "lazy_static",
- "proc-macro2",
- "quote",
- "regex",
- "syn",
-]
-
-[[package]]
-name = "metrics-util"
-version = "0.10.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1174223789e331d9d47a4a953dac36e397db60fa8d2a111ac505388c6c7fe32e"
-dependencies = [
- "ahash",
- "aho-corasick",
- "atomic-shim",
- "crossbeam-epoch",
- "crossbeam-utils",
- "dashmap",
- "hashbrown 0.11.2",
- "indexmap",
- "metrics",
- "num_cpus",
- "ordered-float",
- "parking_lot",
- "quanta",
- "radix_trie",
- "sketches-ddsketch",
-]
-
-[[package]]
-name = "miniz_oxide"
-version = "0.5.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "96590ba8f175222643a85693f33d26e9c8a015f599c216509b1a6894af675d34"
-dependencies = [
- "adler",
-]
-
-[[package]]
-name = "mio"
-version = "0.8.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "57ee1c23c7c63b0c9250c339ffdc69255f110b298b901b9f6c82547b7b87caaf"
-dependencies = [
- "libc",
- "log",
- "wasi 0.11.0+wasi-snapshot-preview1",
- "windows-sys",
-]
-
-[[package]]
-name = "nibble_vec"
-version = "0.1.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "77a5d83df9f36fe23f0c3648c6bbb8b0298bb5f1939c8f2704431371f4b84d43"
-dependencies = [
- "smallvec",
-]
-
-[[package]]
-name = "nix"
-version = "0.23.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9f866317acbd3a240710c63f065ffb1e4fd466259045ccb504130b7f668f35c6"
-dependencies = [
- "bitflags",
- "cc",
- "cfg-if",
- "libc",
- "memoffset",
-]
-
-[[package]]
-name = "num-bigint"
-version = "0.4.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f93ab6289c7b344a8a9f60f88d80aa20032336fe78da341afc91c8a2341fc75f"
-dependencies = [
- "autocfg",
- "num-integer",
- "num-traits",
-]
-
-[[package]]
-name = "num-integer"
-version = "0.1.45"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "225d3389fb3509a24c93f5c29eb6bde2586b98d9f016636dff58d7c6f7569cd9"
-dependencies = [
- "autocfg",
- "num-traits",
-]
-
-[[package]]
-name = "num-traits"
-version = "0.2.15"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "578ede34cf02f8924ab9447f50c28075b4d3e5b269972345e7e0372b38c6cdcd"
-dependencies = [
- "autocfg",
-]
-
-[[package]]
-name = "num_cpus"
-version = "1.13.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "19e64526ebdee182341572e50e9ad03965aa510cd94427a4549448f285e957a1"
-dependencies = [
- "hermit-abi",
- "libc",
-]
-
-[[package]]
-name = "object"
-version = "0.29.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "21158b2c33aa6d4561f1c0a6ea283ca92bc54802a93b263e910746d679a7eb53"
-dependencies = [
- "memchr",
-]
-
-[[package]]
-name = "once_cell"
-version = "1.15.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e82dad04139b71a90c080c8463fe0dc7902db5192d939bd0950f074d014339e1"
-
-[[package]]
-name = "opaque-debug"
-version = "0.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "624a8340c38c1b80fd549087862da4ba43e08858af025b236e509b6649fc13d5"
-
-[[package]]
-name = "ordered-float"
-version = "2.10.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7940cf2ca942593318d07fcf2596cdca60a85c9e7fab408a5e21a4f9dcd40d87"
-dependencies = [
- "num-traits",
-]
-
-[[package]]
-name = "os_str_bytes"
-version = "6.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9ff7415e9ae3fff1225851df9e0d9e4e5479f947619774677a63572e55e80eff"
-
-[[package]]
-name = "owo-colors"
-version = "1.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2386b4ebe91c2f7f51082d4cefa145d030e33a1842a96b12e4885cc3c01f7a55"
-
-[[package]]
-name = "parking_lot"
-version = "0.11.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7d17b78036a60663b797adeaee46f5c9dfebb86948d1255007a1d6be0271ff99"
-dependencies = [
- "instant",
- "lock_api",
- "parking_lot_core",
-]
-
-[[package]]
-name = "parking_lot_core"
-version = "0.8.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d76e8e1493bcac0d2766c42737f34458f1c8c50c0d23bcb24ea953affb273216"
-dependencies = [
- "cfg-if",
- "instant",
- "libc",
- "redox_syscall",
- "smallvec",
- "winapi",
-]
-
-[[package]]
-name = "password-hash"
-version = "0.2.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "77e0b28ace46c5a396546bcf443bf422b57049617433d8854227352a4a9b24e7"
-dependencies = [
- "base64ct",
- "rand_core",
- "subtle",
-]
-
-[[package]]
-name = "pbkdf2"
-version = "0.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d95f5254224e617595d2cc3cc73ff0a5eaf2637519e25f03388154e9378b6ffa"
-dependencies = [
- "base64ct",
- "crypto-mac",
- "hmac",
- "password-hash",
- "sha2",
-]
-
-[[package]]
-name = "pin-project-lite"
-version = "0.2.9"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e0a7ae3ac2f1173085d398531c705756c94a4c56843785df85a60c1a0afac116"
-
-[[package]]
-name = "pin-utils"
-version = "0.1.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8b870d8c151b6f2fb93e84a13146138f05d02ed11c7e7c54f8826aaaf7c9f184"
-
-[[package]]
-name = "pkg-config"
-version = "0.3.25"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1df8c4ec4b0627e53bdf214615ad287367e482558cf84b109250b37464dc03ae"
-
-[[package]]
-name = "ppv-lite86"
-version = "0.2.16"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "eb9f9e6e233e5c4a35559a617bf40a4ec447db2e84c20b55a6f83167b7e57872"
-
-[[package]]
-name = "proc-macro-error"
-version = "1.0.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "da25490ff9892aab3fcf7c36f08cfb902dd3e71ca0f9f9517bea02a73a5ce38c"
-dependencies = [
- "proc-macro-error-attr",
- "proc-macro2",
- "quote",
- "syn",
- "version_check",
-]
-
-[[package]]
-name = "proc-macro-error-attr"
-version = "1.0.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a1be40180e52ecc98ad80b184934baf3d0d29f979574e439af5a55274b35f869"
-dependencies = [
- "proc-macro2",
- "quote",
- "version_check",
-]
-
-[[package]]
-name = "proc-macro2"
-version = "1.0.46"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "94e2ef8dbfc347b10c094890f778ee2e36ca9bb4262e86dc99cd217e35f3470b"
-dependencies = [
- "unicode-ident",
-]
-
-[[package]]
-name = "quanta"
-version = "0.9.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "20afe714292d5e879d8b12740aa223c6a88f118af41870e8b6196e39a02238a8"
-dependencies = [
- "crossbeam-utils",
- "libc",
- "mach",
- "once_cell",
- "raw-cpuid",
- "wasi 0.10.2+wasi-snapshot-preview1",
- "web-sys",
- "winapi",
-]
-
-[[package]]
-name = "quote"
-version = "1.0.21"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bbe448f377a7d6961e30f5955f9b8d106c3f5e449d493ee1b125c1d43c2b5179"
-dependencies = [
- "proc-macro2",
-]
-
-[[package]]
-name = "radix_trie"
-version = "0.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c069c179fcdc6a2fe24d8d18305cf085fdbd4f922c041943e203685d6a1c58fd"
-dependencies = [
- "endian-type",
- "nibble_vec",
-]
-
-[[package]]
-name = "rand"
-version = "0.8.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "34af8d1a0e25924bc5b7c43c079c942339d8f0a8b57c39049bef581b46327404"
-dependencies = [
- "libc",
- "rand_chacha",
- "rand_core",
-]
-
-[[package]]
-name = "rand_chacha"
-version = "0.3.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e6c10a63a0fa32252be49d21e7709d4d4baf8d231c2dbce1eaa8141b9b127d88"
-dependencies = [
- "ppv-lite86",
- "rand_core",
-]
-
-[[package]]
-name = "rand_core"
-version = "0.6.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ec0be4795e2f6a28069bec0b5ff3e2ac9bafc99e6a9a7dc3547996c5c816922c"
-dependencies = [
- "getrandom",
-]
-
-[[package]]
-name = "raw-cpuid"
-version = "10.6.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a6823ea29436221176fe662da99998ad3b4db2c7f31e7b6f5fe43adccd6320bb"
-dependencies = [
- "bitflags",
-]
-
-[[package]]
-name = "redox_syscall"
-version = "0.2.16"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "fb5a58c1855b4b6819d59012155603f0b22ad30cad752600aadfcb695265519a"
-dependencies = [
- "bitflags",
-]
-
-[[package]]
-name = "redox_users"
-version = "0.4.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b033d837a7cf162d7993aded9304e30a83213c648b6e389db233191f891e5c2b"
-dependencies = [
- "getrandom",
- "redox_syscall",
- "thiserror",
-]
-
-[[package]]
-name = "regex"
-version = "1.6.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4c4eb3267174b8c6c2f654116623910a0fef09c4753f8dd83db29c48a0df988b"
-dependencies = [
- "aho-corasick",
- "memchr",
- "regex-syntax",
-]
-
-[[package]]
-name = "regex-automata"
-version = "0.1.10"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "6c230d73fb8d8c1b9c0b3135c5142a8acee3a0558fb8db5cf1cb65f8d7862132"
-dependencies = [
- "regex-syntax",
-]
-
-[[package]]
-name = "regex-syntax"
-version = "0.6.27"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a3f87b73ce11b1619a3c6332f45341e0047173771e8b8b73f87bfeefb7b56244"
-
-[[package]]
-name = "remove_dir_all"
-version = "0.5.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "3acd125665422973a33ac9d3dd2df85edad0f4ae9b00dafb1a05e43a9f5ef8e7"
-dependencies = [
- "winapi",
-]
-
-[[package]]
-name = "rustc-demangle"
-version = "0.1.21"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "7ef03e0a2b150c7a90d01faf6254c9c48a41e95fb2a8c2ac1c6f0d2b9aefc342"
-
-[[package]]
-name = "ryu"
-version = "1.0.11"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4501abdff3ae82a1c1b477a17252eb69cee9e66eb915c1abaa4f44d873df9f09"
-
-[[package]]
-name = "same-file"
-version = "1.0.6"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502"
-dependencies = [
- "winapi-util",
-]
-
-[[package]]
-name = "scopeguard"
-version = "1.1.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "d29ab0c6d3fc0ee92fe66e2d99f700eab17a8d57d1c1d3b748380fb20baa78cd"
-
-[[package]]
-name = "serde"
-version = "1.0.145"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "728eb6351430bccb993660dfffc5a72f91ccc1295abaa8ce19b27ebe4f75568b"
-
-[[package]]
-name = "serde_derive"
-version = "1.0.145"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "81fa1584d3d1bcacd84c277a0dfe21f5b0f6accf4a23d04d4c6d61f1af522b4c"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "serde_json"
-version = "1.0.85"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e55a28e3aaef9d5ce0506d0a14dbba8054ddc7e499ef522dd8b26859ec9d4a44"
-dependencies = [
- "itoa",
- "ryu",
- "serde",
-]
-
-[[package]]
-name = "sha2"
-version = "0.9.9"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4d58a1e1bf39749807d89cf2d98ac2dfa0ff1cb3faa38fbb64dd88ac8013d800"
-dependencies = [
- "block-buffer",
- "cfg-if",
- "cpufeatures",
- "digest",
- "opaque-debug",
-]
-
-[[package]]
-name = "sharded-slab"
-version = "0.1.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "900fba806f70c630b0a382d0d825e17a0f19fcd059a2ade1ff237bcddf446b31"
-dependencies = [
- "lazy_static",
-]
-
-[[package]]
-name = "signal-hook-registry"
-version = "1.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e51e73328dc4ac0c7ccbda3a494dfa03df1de2f46018127f60c693f2648455b0"
-dependencies = [
- "libc",
-]
-
-[[package]]
-name = "sketches-ddsketch"
-version = "0.1.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "04d2ecae5fcf33b122e2e6bd520a57ccf152d2dde3b38c71039df1a6867264ee"
-
-[[package]]
-name = "slab"
-version = "0.4.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4614a76b2a8be0058caa9dbbaf66d988527d86d003c11a94fbd335d7661edcef"
-dependencies = [
- "autocfg",
-]
-
-[[package]]
-name = "smallvec"
-version = "1.9.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2fd0db749597d91ff862fd1d55ea87f7855a744a8425a64695b6fca237d1dad1"
-
-[[package]]
-name = "socket2"
-version = "0.4.7"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "02e2d2db9033d13a1567121ddd7a095ee144db4e1ca1b1bda3419bc0da294ebd"
-dependencies = [
- "libc",
- "winapi",
-]
-
-[[package]]
-name = "strsim"
-version = "0.10.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "73473c0e59e6d5812c5dfe2a064a6444949f089e20eec9a2e5506596494e4623"
-
-[[package]]
-name = "subtle"
-version = "2.4.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "6bdef32e8150c2a081110b42772ffe7d7c9032b606bc226c8260fd97e0976601"
-
-[[package]]
-name = "syn"
-version = "1.0.101"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e90cde112c4b9690b8cbe810cba9ddd8bc1d7472e2cae317b69e9438c1cba7d2"
-dependencies = [
- "proc-macro2",
- "quote",
- "unicode-ident",
-]
-
-[[package]]
-name = "tempfile"
-version = "3.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5cdb1ef4eaeeaddc8fbd371e5017057064af0911902ef36b39801f67cc6d79e4"
-dependencies = [
- "cfg-if",
- "fastrand",
- "libc",
- "redox_syscall",
- "remove_dir_all",
- "winapi",
-]
-
-[[package]]
-name = "termcolor"
-version = "1.1.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bab24d30b911b2376f3a13cc2cd443142f0c81dda04c118693e35b3835757755"
-dependencies = [
- "winapi-util",
-]
-
-[[package]]
-name = "textwrap"
-version = "0.15.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "949517c0cf1bf4ee812e2e07e08ab448e3ae0d23472aee8a06c985f0c8815b16"
-
-[[package]]
-name = "thiserror"
-version = "1.0.37"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "10deb33631e3c9018b9baf9dcbbc4f737320d2b576bac10f6aefa048fa407e3e"
-dependencies = [
- "thiserror-impl",
-]
-
-[[package]]
-name = "thiserror-impl"
-version = "1.0.37"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "982d17546b47146b28f7c22e3d08465f6b8903d0ea13c1660d9d84a6e7adcdbb"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "thread_local"
-version = "1.1.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5516c27b78311c50bf42c071425c560ac799b11c30b31f87e3081965fe5e0180"
-dependencies = [
- "once_cell",
-]
-
-[[package]]
-name = "thrussh"
-version = "0.33.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "8e6540238a9adf83df6e66541c182a52acf892ab335595ca965c229ade8536f8"
-dependencies = [
- "bitflags",
- "byteorder",
- "cryptovec",
- "digest",
- "flate2",
- "futures",
- "generic-array",
- "log",
- "rand",
- "sha2",
- "thiserror",
- "thrussh-keys",
- "thrussh-libsodium",
- "tokio",
-]
-
-[[package]]
-name = "thrussh-keys"
-version = "0.21.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a72cc51a2932b18d92f7289332d8564cec4a5014063722a9d3fdca52c5d8f5ab"
-dependencies = [
- "aes",
- "bcrypt-pbkdf",
- "bit-vec",
- "block-modes",
- "byteorder",
- "cryptovec",
- "data-encoding",
- "dirs",
- "futures",
- "hmac",
- "log",
- "md5",
- "num-bigint",
- "num-integer",
- "pbkdf2",
- "rand",
- "serde",
- "serde_derive",
- "sha2",
- "thiserror",
- "thrussh-libsodium",
- "tokio",
- "tokio-stream",
- "yasna",
-]
-
-[[package]]
-name = "thrussh-libsodium"
-version = "0.2.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "cfe89c70d27b1cb92e13bc8af63493e890d0de46dae4df0e28233f62b4ed9500"
-dependencies = [
- "lazy_static",
- "libc",
- "libsodium-sys",
- "pkg-config",
- "vcpkg",
-]
-
-[[package]]
-name = "tokio"
-version = "1.21.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "a9e03c497dc955702ba729190dc4aac6f2a0ce97f913e5b1b5912fc5039d9099"
-dependencies = [
- "autocfg",
- "bytes",
- "libc",
- "memchr",
- "mio",
- "num_cpus",
- "pin-project-lite",
- "signal-hook-registry",
- "socket2",
- "tokio-macros",
- "winapi",
-]
-
-[[package]]
-name = "tokio-macros"
-version = "1.8.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9724f9a975fb987ef7a3cd9be0350edcbe130698af5b8f7a631e23d42d052484"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "tokio-stream"
-version = "0.1.10"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "f6edf2d6bc038a43d31353570e27270603f4648d18f5ed10c0e179abe43255af"
-dependencies = [
- "futures-core",
- "pin-project-lite",
- "tokio",
-]
-
-[[package]]
-name = "tower-service"
-version = "0.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b6bc1c9ce2b5135ac7f93c72918fc37feb872bdc6a5533a8b85eb4b86bfdae52"
-
-[[package]]
-name = "tracing"
-version = "0.1.36"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "2fce9567bd60a67d08a16488756721ba392f24f29006402881e43b19aac64307"
-dependencies = [
- "cfg-if",
- "pin-project-lite",
- "tracing-attributes",
- "tracing-core",
-]
-
-[[package]]
-name = "tracing-attributes"
-version = "0.1.22"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "11c75893af559bc8e10716548bdef5cb2b983f8e637db9d0e15126b61b484ee2"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
-]
-
-[[package]]
-name = "tracing-core"
-version = "0.1.29"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5aeea4303076558a00714b823f9ad67d58a3bbda1df83d8827d21193156e22f7"
-dependencies = [
- "once_cell",
- "valuable",
-]
-
-[[package]]
-name = "tracing-error"
-version = "0.1.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "b4d7c0b83d4a500748fa5879461652b361edf5c9d51ede2a2ac03875ca185e24"
-dependencies = [
- "tracing",
- "tracing-subscriber",
-]
-
-[[package]]
-name = "tracing-log"
-version = "0.1.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "78ddad33d2d10b1ed7eb9d1f518a5674713876e97e5bb9b7345a7984fbb4f922"
-dependencies = [
- "lazy_static",
- "log",
- "tracing-core",
-]
-
-[[package]]
-name = "tracing-serde"
-version = "0.1.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bc6b213177105856957181934e4920de57730fc69bf42c37ee5bb664d406d9e1"
-dependencies = [
- "serde",
- "tracing-core",
-]
-
-[[package]]
-name = "tracing-subscriber"
-version = "0.2.25"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "0e0d2eaa99c3c2e41547cfa109e910a68ea03823cccad4a0525dcbc9b01e8c71"
-dependencies = [
- "ansi_term",
- "chrono",
- "lazy_static",
- "matchers",
- "regex",
- "serde",
- "serde_json",
- "sharded-slab",
- "smallvec",
- "thread_local",
- "tracing",
- "tracing-core",
- "tracing-log",
- "tracing-serde",
-]
-
-[[package]]
-name = "try-lock"
-version = "0.2.3"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "59547bce71d9c38b83d9c0e92b6066c4253371f15005def0c30d9657f50c7642"
-
-[[package]]
-name = "typenum"
-version = "1.15.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "dcf81ac59edc17cc8697ff311e8f5ef2d99fcbd9817b34cec66f90b6c3dfd987"
-
-[[package]]
-name = "unicode-ident"
-version = "1.0.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "dcc811dc4066ac62f84f11307873c4850cb653bfa9b1719cee2bd2204a4bc5dd"
-
-[[package]]
-name = "valuable"
-version = "0.1.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "830b7e5d4d90034032940e4ace0d9a9a057e7a45cd94e6c007832e39edb82f6d"
-
-[[package]]
-name = "vcpkg"
-version = "0.2.15"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "accd4ea62f7bb7a82fe23066fb0957d48ef677f6eeb8215f372f52e48bb32426"
-
-[[package]]
-name = "version_check"
-version = "0.9.4"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "49874b5167b65d7193b8aba1567f5c7d93d001cafc34600cee003eda787e483f"
-
-[[package]]
-name = "walkdir"
-version = "2.3.2"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "808cf2735cd4b6866113f648b791c6adc5714537bc222d9347bb203386ffda56"
-dependencies = [
- "same-file",
- "winapi",
- "winapi-util",
-]
-
-[[package]]
-name = "want"
-version = "0.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1ce8a968cb1cd110d136ff8b819a556d6fb6d919363c61534f6860c7eb172ba0"
-dependencies = [
- "log",
- "try-lock",
-]
-
-[[package]]
-name = "wasi"
-version = "0.10.2+wasi-snapshot-preview1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "fd6fbd9a79829dd1ad0cc20627bf1ed606756a7f77edff7b66b7064f9cb327c6"
-
-[[package]]
-name = "wasi"
-version = "0.11.0+wasi-snapshot-preview1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9c8d87e72b64a3b4db28d11ce29237c246188f4f51057d65a7eab63b7987e423"
-
-[[package]]
-name = "wasm-bindgen"
-version = "0.2.83"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "eaf9f5aceeec8be17c128b2e93e031fb8a4d469bb9c4ae2d7dc1888b26887268"
-dependencies = [
- "cfg-if",
- "wasm-bindgen-macro",
-]
-
-[[package]]
-name = "wasm-bindgen-backend"
-version = "0.2.83"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4c8ffb332579b0557b52d268b91feab8df3615f265d5270fec2a8c95b17c1142"
-dependencies = [
- "bumpalo",
- "log",
- "once_cell",
- "proc-macro2",
- "quote",
- "syn",
- "wasm-bindgen-shared",
-]
-
-[[package]]
-name = "wasm-bindgen-macro"
-version = "0.2.83"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "052be0f94026e6cbc75cdefc9bae13fd6052cdcaf532fa6c45e7ae33a1e6c810"
-dependencies = [
- "quote",
- "wasm-bindgen-macro-support",
-]
-
-[[package]]
-name = "wasm-bindgen-macro-support"
-version = "0.2.83"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "07bc0c051dc5f23e307b13285f9d75df86bfdf816c5721e573dec1f9b8aa193c"
-dependencies = [
- "proc-macro2",
- "quote",
- "syn",
- "wasm-bindgen-backend",
- "wasm-bindgen-shared",
-]
-
-[[package]]
-name = "wasm-bindgen-shared"
-version = "0.2.83"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "1c38c045535d93ec4f0b4defec448e4291638ee608530863b1e2ba115d4fff7f"
-
-[[package]]
-name = "web-sys"
-version = "0.3.60"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "bcda906d8be16e728fd5adc5b729afad4e444e106ab28cd1c7256e54fa61510f"
-dependencies = [
- "js-sys",
- "wasm-bindgen",
-]
-
-[[package]]
-name = "winapi"
-version = "0.3.9"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419"
-dependencies = [
- "winapi-i686-pc-windows-gnu",
- "winapi-x86_64-pc-windows-gnu",
-]
-
-[[package]]
-name = "winapi-i686-pc-windows-gnu"
-version = "0.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6"
-
-[[package]]
-name = "winapi-util"
-version = "0.1.5"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "70ec6ce85bb158151cae5e5c87f95a8e97d2c0c4b001223f33a334e3ce5de178"
-dependencies = [
- "winapi",
-]
-
-[[package]]
-name = "winapi-x86_64-pc-windows-gnu"
-version = "0.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f"
-
-[[package]]
-name = "windows-sys"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "ea04155a16a59f9eab786fe12a4a450e75cdb175f9e0d80da1e17db09f55b8d2"
-dependencies = [
- "windows_aarch64_msvc",
- "windows_i686_gnu",
- "windows_i686_msvc",
- "windows_x86_64_gnu",
- "windows_x86_64_msvc",
-]
-
-[[package]]
-name = "windows_aarch64_msvc"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "9bb8c3fd39ade2d67e9874ac4f3db21f0d710bee00fe7cab16949ec184eeaa47"
-
-[[package]]
-name = "windows_i686_gnu"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "180e6ccf01daf4c426b846dfc66db1fc518f074baa793aa7d9b9aaeffad6a3b6"
-
-[[package]]
-name = "windows_i686_msvc"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e2e7917148b2812d1eeafaeb22a97e4813dfa60a3f8f78ebe204bcc88f12f024"
-
-[[package]]
-name = "windows_x86_64_gnu"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4dcd171b8776c41b97521e5da127a2d86ad280114807d0b2ab1e462bc764d9e1"
-
-[[package]]
-name = "windows_x86_64_msvc"
-version = "0.36.1"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "c811ca4a8c853ef420abd8592ba53ddbbac90410fab6903b3e79972a631f7680"
-
-[[package]]
-name = "xanthous-server"
-version = "0.1.0"
-dependencies = [
- "base64ct",
- "clap",
- "color-eyre",
- "eyre",
- "futures",
- "libc",
- "metrics",
- "metrics-exporter-prometheus",
- "nix",
- "pbkdf2",
- "tempfile",
- "thrussh",
- "thrussh-keys",
- "tokio",
- "tracing",
- "tracing-subscriber",
-]
-
-[[package]]
-name = "yasna"
-version = "0.4.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "e262a29d0e61ccf2b6190d7050d4b237535fc76ce4c1210d9caa316f71dffa75"
-dependencies = [
- "bit-vec",
- "num-bigint",
-]
-
-[[package]]
-name = "zeroize"
-version = "1.3.0"
-source = "registry+https://github.com/rust-lang/crates.io-index"
-checksum = "4756f7db3f7b5574938c3eb1c117038b8e07f95ee6718c0efad4ac21508f1efd"
diff --git a/users/grfn/xanthous/server/Cargo.toml b/users/grfn/xanthous/server/Cargo.toml
deleted file mode 100644
index d4a064beb697..000000000000
--- a/users/grfn/xanthous/server/Cargo.toml
+++ /dev/null
@@ -1,29 +0,0 @@
-[package]
-name = "xanthous-server"
-version = "0.1.0"
-edition = "2018"
-
-[dependencies]
-clap = { version = "3.0", features = [ "derive", "env" ] }
-color-eyre = "0.5.11"
-eyre = "0.6.5"
-thrussh = "0.33.5"
-thrussh-keys = "0.21.0"
-tracing = "0.1.29"
-tracing-subscriber = "0.2.25"
-metrics = "0.17.0"
-metrics-exporter-prometheus = "0.6.1"
-futures = "0.3.17"
-libc = "0.2.103"
-nix = "0.23.0"
-
-# Pins for rust 1.55 (2018 edition) until we have 1.56 in nixpkgs-unstable
-pbkdf2 = "<0.9"
-base64ct = "<1.2"
-
-[dependencies.tokio]
-version = "1.13"
-features = ["rt", "rt-multi-thread", "macros", "net", "process", "fs", "signal"]
-
-[dev-dependencies]
-tempfile = "3.2.0"
diff --git a/users/grfn/xanthous/server/default.nix b/users/grfn/xanthous/server/default.nix
deleted file mode 100644
index 572230a56c5e..000000000000
--- a/users/grfn/xanthous/server/default.nix
+++ /dev/null
@@ -1,24 +0,0 @@
-args@{ depot ? import ../../../.. { }
-, pkgs ? depot.third_party.nixpkgs
-, ...
-}:
-
-depot.third_party.naersk.buildPackage {
-  name = "xanthous-server";
-  version = "0.0.1";
-  src = depot.third_party.gitignoreSource ./.;
-
-  # Workaround for a potential Nix bug related to restricted eval.
-  # See https://github.com/nix-community/naersk/issues/169
-  root = depot.nix.sparseTree {
-    root = ./.;
-    paths = [
-      ./Cargo.toml
-      ./Cargo.lock
-    ];
-  };
-
-  passthru = {
-    docker = import ./docker.nix args;
-  };
-}
diff --git a/users/grfn/xanthous/server/docker.nix b/users/grfn/xanthous/server/docker.nix
deleted file mode 100644
index 09054cb00fcf..000000000000
--- a/users/grfn/xanthous/server/docker.nix
+++ /dev/null
@@ -1,21 +0,0 @@
-{ depot ? import ../../../.. { }
-, pkgs ? depot.third_party.nixpkgs
-, ...
-}:
-
-let
-  inherit (depot.users.grfn) xanthous;
-  xanthous-server = xanthous.server;
-in
-pkgs.dockerTools.buildLayeredImage {
-  name = "xanthous-server";
-  tag = "latest";
-  contents = [ xanthous xanthous-server ];
-  config = {
-    Cmd = [
-      "${xanthous-server}/bin/xanthous-server"
-      "--xanthous-binary-path"
-      "${xanthous}/bin/xanthous"
-    ];
-  };
-}
diff --git a/users/grfn/xanthous/server/module.nix b/users/grfn/xanthous/server/module.nix
deleted file mode 100644
index 82de6e38e1af..000000000000
--- a/users/grfn/xanthous/server/module.nix
+++ /dev/null
@@ -1,49 +0,0 @@
-{ config, lib, pkgs, depot, ... }:
-
-let
-  cfg = config.services.xanthous-server;
-in
-{
-  options = with lib; {
-    services.xanthous-server = {
-      enable = mkEnableOption "xanthous server";
-
-      port = mkOption {
-        type = types.int;
-        default = 2222;
-        description = "Port to listen to for SSH connections";
-      };
-
-      metricsPort = mkOption {
-        type = types.int;
-        default = 9000;
-        description = "Port to listen to for prometheus metrics";
-      };
-
-      image = mkOption {
-        type = types.package;
-        default = depot.users.grfn.xanthous.server.docker;
-        description = "OCI image file to run";
-      };
-
-      ed25519SecretKeyFile = mkOption {
-        type = with types; uniq string;
-        description = "Path to the ed25519 secret key for the server";
-      };
-    };
-  };
-
-  config = lib.mkIf cfg.enable {
-    virtualisation.oci-containers.containers."xanthous-server" = {
-      autoStart = true;
-      image = "${cfg.image.imageName}:${cfg.image.imageTag}";
-      imageFile = cfg.image;
-      ports = [
-        "${toString cfg.port}:22"
-        "${toString cfg.metricsPort}:9000"
-      ];
-      environment.SECRET_KEY_FILE = "/secret-key";
-      volumes = [ "/etc/secrets/xanthous-server-secret-key:/secret-key" ];
-    };
-  };
-}
diff --git a/users/grfn/xanthous/server/shell.nix b/users/grfn/xanthous/server/shell.nix
deleted file mode 100644
index e01c0316a6b2..000000000000
--- a/users/grfn/xanthous/server/shell.nix
+++ /dev/null
@@ -1,11 +0,0 @@
-let
-  depot = import ../../../.. { };
-  pkgs = depot.third_party.nixpkgs;
-in
-
-pkgs.mkShell {
-  buildInputs = with pkgs; [
-    rustup
-    rust-analyzer
-  ];
-}
diff --git a/users/grfn/xanthous/server/src/main.rs b/users/grfn/xanthous/server/src/main.rs
deleted file mode 100644
index 1b2c1c104b33..000000000000
--- a/users/grfn/xanthous/server/src/main.rs
+++ /dev/null
@@ -1,385 +0,0 @@
-use std::net::SocketAddr;
-use std::path::PathBuf;
-use std::pin::Pin;
-use std::process::Command;
-use std::str;
-use std::sync::Arc;
-
-use clap::Parser;
-use color_eyre::eyre::Result;
-use eyre::{bail, Context};
-use futures::future::{ready, Ready};
-use futures::Future;
-use metrics_exporter_prometheus::PrometheusBuilder;
-use nix::pty::Winsize;
-use pty::ChildHandle;
-use thrussh::server::{self, Auth, Session};
-use thrussh::{ChannelId, CryptoVec};
-use thrussh_keys::decode_secret_key;
-use thrussh_keys::key::KeyPair;
-use tokio::fs::File;
-use tokio::io::{AsyncReadExt, AsyncWriteExt};
-use tokio::net::TcpListener;
-use tokio::select;
-use tokio::time::Instant;
-use tracing::{debug, error, info, info_span, trace, warn, Instrument};
-use tracing_subscriber::EnvFilter;
-
-use crate::pty::WaitPid;
-
-mod metrics;
-mod pty;
-
-use crate::metrics::reported::*;
-use crate::metrics::{decrement_gauge, histogram, increment_counter, increment_gauge};
-
-/// SSH-compatible server for playing Xanthous
-#[derive(Parser, Debug)]
-struct Opts {
-    /// Address to bind to
-    #[clap(long, short = 'a', default_value = "0.0.0.0:22")]
-    address: String,
-
-    /// Address to listen to for metrics
-    #[clap(long, default_value = "0.0.0.0:9000")]
-    metrics_address: SocketAddr,
-
-    /// Format to use when emitting log events
-    #[clap(
-        long,
-        env = "LOG_FORMAT",
-        default_value = "full",
-        possible_values = &["compact", "full", "pretty", "json"]
-    )]
-    log_format: String,
-
-    /// Full path to the xanthous binary
-    #[clap(long, env = "XANTHOUS_BINARY_PATH")]
-    xanthous_binary_path: String,
-
-    /// Path to a file containing the ed25519 secret key for the server
-    #[clap(long, env = "SECRET_KEY_FILE")]
-    secret_key_file: PathBuf,
-
-    /// Level to log at
-    #[clap(long, env = "LOG_LEVEL", default_value = "info")]
-    log_level: String,
-}
-
-impl Opts {
-    async fn read_secret_key(&self) -> Result<KeyPair> {
-        let mut file = File::open(&self.secret_key_file)
-            .await
-            .context("Reading secret key file")?;
-        let mut secret_key = Vec::with_capacity(464);
-        file.read_to_end(&mut secret_key).await?;
-        Ok(decode_secret_key(str::from_utf8(&secret_key)?, None)?)
-    }
-
-    async fn ssh_server_config(&self) -> Result<server::Config> {
-        let key_pair = self.read_secret_key().await?;
-
-        Ok(server::Config {
-            server_id: "SSH-2.0-xanthous".to_owned(),
-            keys: vec![key_pair],
-            ..Default::default()
-        })
-    }
-
-    fn init_logging(&self) -> Result<()> {
-        let filter = EnvFilter::try_new(&self.log_level)?;
-        let s = tracing_subscriber::fmt().with_env_filter(filter);
-
-        match self.log_format.as_str() {
-            "compact" => s.compact().init(),
-            "full" => s.init(),
-            "pretty" => s.pretty().init(),
-            "json" => s.json().with_current_span(true).init(),
-            f => bail!("Invalid log format `{}`", f),
-        }
-
-        Ok(())
-    }
-}
-
-struct Handler {
-    address: SocketAddr,
-    xanthous_binary_path: &'static str,
-    username: Option<String>,
-    child: Option<ChildHandle>,
-}
-
-async fn run_child(
-    mut child: pty::Child,
-    mut server_handle: server::Handle,
-    channel_id: ChannelId,
-) -> Result<()> {
-    let mut buf = [0; 2048];
-    loop {
-        select! {
-            r = child.tty.read(&mut buf)  => {
-                let read_bytes = r?;
-                if read_bytes == 0 {
-                    info!("EOF received from process");
-                    let _ = server_handle.close(channel_id).await;
-                    return Ok(())
-                } else {
-                    trace!(?read_bytes, "read bytes from child");
-                    let _ = server_handle.data(channel_id, CryptoVec::from_slice(&buf[..read_bytes])).await;
-                }
-            }
-            status = WaitPid::new(child.pid) => {
-                match status {
-                    Ok(_status) => info!("Child exited"),
-                    Err(error) => error!(%error, "Child failed"),
-                }
-                let _ = server_handle.close(channel_id).await;
-                return Ok(())
-            }
-        }
-    }
-}
-
-impl Handler {
-    async fn spawn_shell(
-        &mut self,
-        mut handle: server::Handle,
-        channel_id: ChannelId,
-        term: String,
-        winsize: Winsize,
-    ) -> Result<()> {
-        let mut cmd = Command::new(self.xanthous_binary_path);
-        cmd.env("TERM", term);
-        if let Some(username) = &self.username {
-            cmd.args(["--name", username]);
-        }
-        cmd.arg("--disable-saving");
-
-        let child = pty::spawn(cmd, Some(winsize), None).await?;
-        info!(pid = %child.pid, "Spawned child");
-        increment_gauge!(RUNNING_PROCESSES, 1.0);
-        self.child = Some(child.handle().await?);
-        tokio::spawn(
-            async move {
-                let span = info_span!("child", pid = %child.pid);
-                if let Err(error) = run_child(child, handle.clone(), channel_id)
-                    .instrument(span.clone())
-                    .await
-                {
-                    span.in_scope(|| error!(%error, "Error running child"));
-                    let _ = handle.close(channel_id).await;
-                }
-                decrement_gauge!(RUNNING_PROCESSES, 1.0);
-            }
-            .in_current_span(),
-        );
-        Ok(())
-    }
-}
-
-#[allow(clippy::type_complexity)]
-impl server::Handler for Handler {
-    type Error = eyre::Error;
-    type FutureAuth = Ready<Result<(Self, Auth)>>;
-    type FutureUnit = Pin<Box<dyn Future<Output = Result<(Self, Session)>> + Send + 'static>>;
-    type FutureBool = Ready<Result<(Self, Session, bool)>>;
-
-    fn finished_auth(self, auth: Auth) -> Self::FutureAuth {
-        ready(Ok((self, auth)))
-    }
-
-    fn finished_bool(self, b: bool, session: Session) -> Self::FutureBool {
-        ready(Ok((self, session, b)))
-    }
-
-    fn finished(self, session: Session) -> Self::FutureUnit {
-        Box::pin(ready(Ok((self, session))))
-    }
-
-    fn auth_none(mut self, username: &str) -> Self::FutureAuth {
-        info!(%username, "Accepted new connection");
-        self.username = Some(username.to_owned());
-        self.finished_auth(Auth::Accept)
-    }
-
-    fn auth_password(mut self, username: &str, _password: &str) -> Self::FutureAuth {
-        info!(%username, "Accepted new connection");
-        self.username = Some(username.to_owned());
-        self.finished_auth(Auth::Accept)
-    }
-
-    fn auth_publickey(
-        mut self,
-        username: &str,
-        _: &thrussh_keys::key::PublicKey,
-    ) -> Self::FutureAuth {
-        info!(%username, "Accepted new connection");
-        self.username = Some(username.to_owned());
-        self.finished_auth(Auth::Accept)
-    }
-
-    fn pty_request(
-        mut self,
-        channel: thrussh::ChannelId,
-        term: &str,
-        col_width: u32,
-        row_height: u32,
-        pix_width: u32,
-        pix_height: u32,
-        modes: &[(thrussh::Pty, u32)],
-        session: Session,
-    ) -> Self::FutureUnit {
-        let term = term.to_owned();
-        let modes = modes.to_vec();
-        Box::pin(async move {
-            debug!(
-                %term,
-                %col_width,
-                %row_height,
-                %pix_width,
-                %pix_height,
-                ?modes,
-                "PTY Requested"
-            );
-
-            self.spawn_shell(
-                session.handle(),
-                channel,
-                term,
-                Winsize {
-                    ws_row: row_height as _,
-                    ws_col: col_width as _,
-                    ws_xpixel: pix_width as _,
-                    ws_ypixel: pix_height as _,
-                },
-            )
-            .await?;
-
-            Ok((self, session))
-        })
-    }
-
-    fn window_change_request(
-        mut self,
-        _channel: ChannelId,
-        col_width: u32,
-        row_height: u32,
-        pix_width: u32,
-        pix_height: u32,
-        session: Session,
-    ) -> Self::FutureUnit {
-        Box::pin(async move {
-            if let Some(child) = self.child.as_mut() {
-                trace!(%row_height, %col_width, "Window resize request received");
-                child
-                    .resize_window(Winsize {
-                        ws_row: row_height as _,
-                        ws_col: col_width as _,
-                        ws_xpixel: pix_width as _,
-                        ws_ypixel: pix_height as _,
-                    })
-                    .await?;
-            } else {
-                warn!("Resize request received without child process; ignoring");
-            }
-
-            Ok((self, session))
-        })
-    }
-
-    fn data(
-        mut self,
-        _channel: thrussh::ChannelId,
-        data: &[u8],
-        session: Session,
-    ) -> Self::FutureUnit {
-        trace!(data = %String::from_utf8_lossy(data), raw_data = ?data);
-        let data = data.to_owned();
-        Box::pin(async move {
-            if let Some(child) = self.child.as_mut() {
-                child.write_all(&data).await?;
-            } else {
-                warn!("Data received without child process; ignoring");
-            }
-
-            Ok((self, session))
-        })
-    }
-}
-
-#[tokio::main]
-async fn main() -> Result<()> {
-    color_eyre::install()?;
-    let opts = Box::leak::<'static>(Box::new(Opts::parse()));
-    opts.init_logging()?;
-    PrometheusBuilder::new()
-        .listen_address(opts.metrics_address)
-        .install()?;
-    metrics::register();
-
-    let config = Arc::new(opts.ssh_server_config().await?);
-    info!(address = %opts.address, "Listening for new SSH connections");
-    let listener = TcpListener::bind(&opts.address).await?;
-
-    loop {
-        let (stream, address) = listener.accept().await?;
-        increment_counter!(CONNECTIONS_ACCEPTED);
-        increment_gauge!(ACTIVE_CONNECTIONS, 1.0);
-        let config = config.clone();
-        let handler = Handler {
-            xanthous_binary_path: &opts.xanthous_binary_path,
-            address,
-            username: None,
-            child: None,
-        };
-        tokio::spawn(async move {
-            let span = info_span!("client", address = %handler.address);
-            let start = Instant::now();
-            if let Err(error) = server::run_stream(config, stream, handler)
-                .instrument(span.clone())
-                .await
-            {
-                span.in_scope(|| error!(%error));
-            }
-            let duration = start.elapsed();
-            span.in_scope(|| info!(duration_ms = %duration.as_millis(), "Client disconnected"));
-            histogram!(CONNECTION_DURATION, duration);
-            decrement_gauge!(ACTIVE_CONNECTIONS, 1.0);
-        });
-    }
-}
-
-#[cfg(test)]
-mod tests {
-    use tempfile::NamedTempFile;
-
-    use super::*;
-
-    #[tokio::test]
-    async fn read_secret_key() {
-        use std::io::Write;
-
-        let mut file = NamedTempFile::new().unwrap();
-        file.write_all(
-            b"
------BEGIN OPENSSH PRIVATE KEY-----
-b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW
-QyNTUxOQAAACAYz80xcK7jYxZMAl6apIHKRtB0Z2U78gG39c1QaIhgMwAAAJB9vxK9fb8S
-vQAAAAtzc2gtZWQyNTUxOQAAACAYz80xcK7jYxZMAl6apIHKRtB0Z2U78gG39c1QaIhgMw
-AAAEDNZ0d3lLNBGU6Im4JOpr490TOjm+cB7kMVXjVg3iCowBjPzTFwruNjFkwCXpqkgcpG
-0HRnZTvyAbf1zVBoiGAzAAAACHRlc3Qta2V5AQIDBAU=
------END OPENSSH PRIVATE KEY-----
-",
-        )
-        .unwrap();
-
-        let opts: Opts = Opts::parse_from(&[
-            "xanthous-server".as_ref(),
-            "--xanthous-binary-path".as_ref(),
-            "/bin/xanthous".as_ref(),
-            "--secret-key-file".as_ref(),
-            file.path().as_os_str(),
-        ]);
-        opts.read_secret_key().await.unwrap();
-    }
-}
diff --git a/users/grfn/xanthous/server/src/metrics.rs b/users/grfn/xanthous/server/src/metrics.rs
deleted file mode 100644
index 6912cdd9c9ee..000000000000
--- a/users/grfn/xanthous/server/src/metrics.rs
+++ /dev/null
@@ -1,24 +0,0 @@
-pub use ::metrics::*;
-
-pub mod reported {
-    /// Counter: Connections accepted on the TCP listener
-    pub const CONNECTIONS_ACCEPTED: &str = "ssh.connections.accepted";
-
-    /// Histogram: Connection duration
-    pub const CONNECTION_DURATION: &str = "ssh.connections.duration";
-
-    /// Gauge: Currently active connections
-    pub const ACTIVE_CONNECTIONS: &str = "ssh.connections.active";
-
-    /// Gauge: Currently running xanthous processes
-    pub const RUNNING_PROCESSES: &str = "ssh.child.processes";
-}
-
-pub fn register() {
-    use reported::*;
-
-    register_counter!(CONNECTIONS_ACCEPTED);
-    register_histogram!(CONNECTION_DURATION);
-    register_gauge!(ACTIVE_CONNECTIONS);
-    register_gauge!(RUNNING_PROCESSES);
-}
diff --git a/users/grfn/xanthous/server/src/pty.rs b/users/grfn/xanthous/server/src/pty.rs
deleted file mode 100644
index 234ecd8f2336..000000000000
--- a/users/grfn/xanthous/server/src/pty.rs
+++ /dev/null
@@ -1,172 +0,0 @@
-use std::io::{self};
-use std::os::unix::prelude::{AsRawFd, CommandExt, FromRawFd};
-use std::pin::Pin;
-use std::process::{abort, Command};
-use std::task::{Context, Poll};
-
-use eyre::{bail, Result};
-use futures::Future;
-use nix::pty::{forkpty, Winsize};
-use nix::sys::termios::Termios;
-use nix::sys::wait::{waitpid, WaitPidFlag, WaitStatus};
-use nix::unistd::{ForkResult, Pid};
-use tokio::fs::File;
-use tokio::io::{AsyncRead, AsyncWrite};
-use tokio::signal::unix::{signal, Signal, SignalKind};
-use tokio::task::spawn_blocking;
-
-mod ioctl {
-    use super::Winsize;
-    use libc::TIOCSWINSZ;
-    use nix::ioctl_write_ptr_bad;
-
-    ioctl_write_ptr_bad!(tiocswinsz, TIOCSWINSZ, Winsize);
-}
-
-async fn asyncify<F, T>(f: F) -> Result<T>
-where
-    F: FnOnce() -> Result<T> + Send + 'static,
-    T: Send + 'static,
-{
-    match spawn_blocking(f).await {
-        Ok(res) => res,
-        Err(_) => bail!("background task failed",),
-    }
-}
-
-pub struct Child {
-    pub tty: File,
-    pub pid: Pid,
-}
-
-pub struct ChildHandle {
-    pub tty: File,
-}
-
-pub struct WaitPid {
-    pid: Pid,
-    signal: Signal,
-}
-
-impl WaitPid {
-    pub fn new(pid: Pid) -> Self {
-        Self {
-            pid,
-            signal: signal(SignalKind::child()).unwrap(),
-        }
-    }
-}
-
-impl Future for WaitPid {
-    type Output = nix::Result<WaitStatus>;
-
-    fn poll(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Self::Output> {
-        let _ = self.signal.poll_recv(cx);
-        match waitpid(self.pid, Some(WaitPidFlag::WNOHANG)) {
-            Ok(WaitStatus::StillAlive) => Poll::Pending,
-            result => Poll::Ready(result),
-        }
-    }
-}
-
-impl Child {
-    pub async fn handle(&self) -> io::Result<ChildHandle> {
-        Ok(ChildHandle {
-            tty: self.tty.try_clone().await?,
-        })
-    }
-}
-
-impl ChildHandle {
-    pub async fn resize_window(&mut self, winsize: Winsize) -> Result<()> {
-        let fd = self.tty.as_raw_fd();
-        asyncify(move || unsafe {
-            ioctl::tiocswinsz(fd, &winsize as *const Winsize)?;
-            Ok(())
-        })
-        .await
-    }
-}
-
-pub async fn spawn(
-    mut cmd: Command,
-    winsize: Option<Winsize>,
-    termios: Option<Termios>,
-) -> Result<Child> {
-    asyncify(move || unsafe {
-        let res = forkpty(winsize.as_ref(), termios.as_ref())?;
-        match res.fork_result {
-            ForkResult::Parent { child } => Ok(Child {
-                pid: child,
-                tty: File::from_raw_fd(res.master),
-            }),
-            ForkResult::Child => {
-                cmd.exec();
-                abort();
-            }
-        }
-    })
-    .await
-}
-
-impl AsyncRead for Child {
-    fn poll_read(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-        buf: &mut tokio::io::ReadBuf<'_>,
-    ) -> Poll<io::Result<()>> {
-        Pin::new(&mut self.tty).poll_read(cx, buf)
-    }
-}
-
-impl AsyncWrite for Child {
-    fn poll_write(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-        buf: &[u8],
-    ) -> Poll<Result<usize, io::Error>> {
-        Pin::new(&mut self.tty).poll_write(cx, buf)
-    }
-
-    fn poll_flush(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Result<(), io::Error>> {
-        Pin::new(&mut self.tty).poll_flush(cx)
-    }
-
-    fn poll_shutdown(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-    ) -> Poll<Result<(), io::Error>> {
-        Pin::new(&mut self.tty).poll_shutdown(cx)
-    }
-}
-
-impl AsyncRead for ChildHandle {
-    fn poll_read(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-        buf: &mut tokio::io::ReadBuf<'_>,
-    ) -> Poll<io::Result<()>> {
-        Pin::new(&mut self.tty).poll_read(cx, buf)
-    }
-}
-
-impl AsyncWrite for ChildHandle {
-    fn poll_write(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-        buf: &[u8],
-    ) -> Poll<Result<usize, io::Error>> {
-        Pin::new(&mut self.tty).poll_write(cx, buf)
-    }
-
-    fn poll_flush(mut self: Pin<&mut Self>, cx: &mut Context<'_>) -> Poll<Result<(), io::Error>> {
-        Pin::new(&mut self.tty).poll_flush(cx)
-    }
-
-    fn poll_shutdown(
-        mut self: Pin<&mut Self>,
-        cx: &mut Context<'_>,
-    ) -> Poll<Result<(), io::Error>> {
-        Pin::new(&mut self.tty).poll_shutdown(cx)
-    }
-}
diff --git a/users/grfn/xanthous/shell.nix b/users/grfn/xanthous/shell.nix
deleted file mode 100644
index 2c41cb4aa864..000000000000
--- a/users/grfn/xanthous/shell.nix
+++ /dev/null
@@ -1,23 +0,0 @@
-let
-  depot = import ../../../. { };
-  inherit (depot) third_party;
-  pkgs = third_party.nixpkgs;
-in
-
-(pkgs.haskell.packages.ghc8107.extend (pkgs.haskell.lib.packageSourceOverrides {
-  xanthous = third_party.gitignoreSource ./.;
-})).shellFor {
-  packages = p: [ p.xanthous ];
-  withHoogle = true;
-  doBenchmark = true;
-  buildInputs = (with pkgs.haskell.packages.ghc8107; [
-    cabal-install
-    ghc-prof-flamegraph
-    hp2pretty
-    hlint
-    haskell-language-server
-    cabal2nix
-  ]) ++ (with pkgs; [
-    qpdf
-  ]);
-}
diff --git a/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs b/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs
deleted file mode 100644
index e89fcd621157..000000000000
--- a/users/grfn/xanthous/src/Data/Aeson/Generic/DerivingVia.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-{-# LANGUAGE ConstraintKinds, DataKinds, DeriveGeneric, DerivingVia    #-}
-{-# LANGUAGE ExplicitNamespaces, FlexibleContexts, FlexibleInstances   #-}
-{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses  #-}
-{-# LANGUAGE PolyKinds, ScopedTypeVariables, StandaloneDeriving        #-}
-{-# LANGUAGE TypeApplications, TypeFamilies, TypeInType, TypeOperators #-}
-{-# LANGUAGE UndecidableInstances                                      #-}
-{-# OPTIONS_GHC -Wall #-}
--- | https://gist.github.com/konn/27c00f784dd883ec2b90eab8bc84a81d
-module Data.Aeson.Generic.DerivingVia
-     ( StrFun(..), Setting(..), SumEncoding'(..), DefaultOptions, WithOptions(..)
-     , -- Utility type synonyms to save ticks (') before promoted data constructors
-       type Drop, type CamelTo2, type UserDefined
-     , type TaggedObj, type UntaggedVal, type ObjWithSingleField, type TwoElemArr
-     , type FieldLabelModifier
-     , type ConstructorTagModifier
-     , type AllNullaryToStringTag
-     , type OmitNothingFields
-     , type SumEnc
-     , type UnwrapUnaryRecords
-     , type TagSingleConstructors
-     )
-  where
-
-import           Prelude
-import           Data.Aeson      (FromJSON (..), GFromJSON, GToJSON,
-                                  ToJSON (..))
-import           Data.Aeson      (Options (..), Zero, camelTo2,
-                                  genericParseJSON)
-import           Data.Aeson      (defaultOptions, genericToJSON)
-import qualified Data.Aeson      as Aeson
-import           Data.Kind       (Constraint, Type)
-import           Data.Proxy      (Proxy (..))
-import           Data.Reflection (Reifies (..))
-import           GHC.Generics    (Generic, Rep)
-import           GHC.TypeLits    (KnownNat, KnownSymbol, natVal, symbolVal)
-import           GHC.TypeLits    (Nat, Symbol)
-
-newtype WithOptions options a = WithOptions { runWithOptions :: a }
-
-data StrFun = Drop     Nat
-            | CamelTo2 Symbol
-            | forall p. UserDefined p
-
-type Drop = 'Drop
-type CamelTo2 = 'CamelTo2
-type UserDefined = 'UserDefined
-
-type family Demoted a where
-  Demoted Symbol  = String
-  Demoted StrFun  = String -> String
-  Demoted [a]     = [Demoted a]
-  Demoted Setting = Options -> Options
-  Demoted SumEncoding' = Aeson.SumEncoding
-  Demoted a = a
-
-data SumEncoding' = TaggedObj {tagFieldName' :: Symbol, contentsFieldName :: Symbol }
-                  | UntaggedVal
-                  | ObjWithSingleField
-                  | TwoElemArr
-
-type TaggedObj          = 'TaggedObj
-type UntaggedVal        = 'UntaggedVal
-type ObjWithSingleField = 'ObjWithSingleField
-type TwoElemArr         = 'TwoElemArr
-
-data Setting = FieldLabelModifier     [StrFun]
-             | ConstructorTagModifier [StrFun]
-             | AllNullaryToStringTag  Bool
-             | OmitNothingFields      Bool
-             | SumEnc                 SumEncoding'
-             | UnwrapUnaryRecords     Bool
-             | TagSingleConstructors  Bool
-
-type FieldLabelModifier     = 'FieldLabelModifier
-type ConstructorTagModifier = 'ConstructorTagModifier
--- | If 'True' the constructors of a datatype, with all nullary constructors,
--- will be encoded to just a string with the constructor tag. If 'False' the
--- encoding will always follow the 'SumEncoding'.
-type AllNullaryToStringTag  = 'AllNullaryToStringTag
-type OmitNothingFields      = 'OmitNothingFields
-type SumEnc                 = 'SumEnc
--- | Hide the field name when a record constructor has only one field, like a
--- newtype.
-type UnwrapUnaryRecords     = 'UnwrapUnaryRecords
--- | Encode types with a single constructor as sums, so that
--- 'AllNullaryToStringTag' and 'SumEncoding' apply.
-type TagSingleConstructors  = 'TagSingleConstructors
-
-class Demotable (a :: k) where
-  demote :: proxy a -> Demoted k
-
-type All :: (Type -> Constraint) -> [Type] -> Constraint
-type family All p xs where
-  All p '[] = ()
-  All p (x ': xs) = (p x, All p xs)
-
-instance Reifies f (String -> String) => Demotable ('UserDefined f) where
-  demote _ = reflect @f Proxy
-
-instance KnownSymbol sym => Demotable sym where
-  demote = symbolVal
-
-instance (KnownSymbol s, KnownSymbol t) => Demotable ('TaggedObj s t) where
-  demote _ = Aeson.TaggedObject (symbolVal @s Proxy) (symbolVal @t Proxy)
-
-instance Demotable 'UntaggedVal where
-  demote _ = Aeson.UntaggedValue
-
-instance Demotable 'ObjWithSingleField where
-  demote _ = Aeson.ObjectWithSingleField
-
-instance Demotable 'TwoElemArr where
-  demote _ = Aeson.TwoElemArray
-
-instance Demotable xs => Demotable ('FieldLabelModifier xs) where
-  demote _ o = o { fieldLabelModifier = foldr (.) id (demote (Proxy @xs)) }
-
-instance Demotable xs => Demotable ('ConstructorTagModifier xs) where
-  demote _ o = o { constructorTagModifier = foldr (.) id (demote (Proxy @xs)) }
-
-instance Demotable b => Demotable ('AllNullaryToStringTag b) where
-  demote _ o = o { allNullaryToStringTag = demote (Proxy @b) }
-
-instance Demotable b => Demotable ('OmitNothingFields b) where
-  demote _ o = o { omitNothingFields = demote (Proxy @b) }
-
-instance Demotable b => Demotable ('UnwrapUnaryRecords b) where
-  demote _ o = o { unwrapUnaryRecords = demote (Proxy @b) }
-
-instance Demotable b => Demotable ('TagSingleConstructors b) where
-  demote _ o = o { tagSingleConstructors = demote (Proxy @b) }
-
-instance Demotable b => Demotable ('SumEnc b) where
-  demote _ o = o { sumEncoding = demote (Proxy @b) }
-
-instance Demotable 'True where
-  demote _ = True
-
-instance Demotable 'False where
-  demote _ = False
-
-instance KnownNat n => Demotable ('Drop n) where
-  demote _ = drop (fromIntegral $ natVal (Proxy :: Proxy n))
-
-instance KnownSymbol sym => Demotable ('CamelTo2 sym) where
-  demote _ = camelTo2 $ head $ symbolVal @sym Proxy
-
-instance {-# OVERLAPPING #-} Demotable ('[] :: [k]) where
-  demote _ = []
-
-instance (Demotable (x :: k), Demotable (xs :: [k])) => Demotable (x ': xs) where
-  demote _ = demote (Proxy @x) : demote (Proxy @xs)
-
-type DefaultOptions = ('[] :: [Setting])
-
-reflectOptions :: forall xs proxy. Demotable (xs :: [Setting]) => proxy xs -> Options
-reflectOptions pxy = foldr (.) id (demote pxy) defaultOptions
-
-instance (Demotable (options :: [Setting])) => Reifies options Options where
-  reflect = reflectOptions
-
-instance (Generic a, GToJSON Zero (Rep a), Reifies (options :: k) Options)
-       => ToJSON (WithOptions options a) where
-  toJSON = genericToJSON (reflect (Proxy @options)) . runWithOptions
-
-instance (Generic a, GFromJSON Zero (Rep a), Reifies (options :: k) Options)
-       => FromJSON (WithOptions options a) where
-  parseJSON = fmap WithOptions . genericParseJSON (reflect (Proxy @options))
diff --git a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs b/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs
deleted file mode 100644
index 1f2b513ffe0e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/AI/Gormlak.hs
+++ /dev/null
@@ -1,201 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE UndecidableInstances #-}
---------------------------------------------------------------------------------
-module Xanthous.AI.Gormlak
-  ( HasVisionRadius(..)
-  , GormlakBrain(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (lines)
---------------------------------------------------------------------------------
-import           Control.Monad.State
-import           Control.Monad.Random
-import           Data.Aeson (object)
-import qualified Data.Aeson as A
-import           Data.Generics.Product.Fields
---------------------------------------------------------------------------------
-import           Xanthous.Data
-                 ( Positioned(..), positioned, position, _Position
-                 , diffPositions, stepTowards, isUnit
-                 , Ticks, (|*|), invertedRate
-                 )
-import           Xanthous.Data.EntityMap
-import           Xanthous.Entities.Creature.Hippocampus
-import           Xanthous.Entities.Character (Character)
-import qualified Xanthous.Entities.Character as Character
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Entities.RawTypes
-                 ( CreatureType, HasLanguage(language), getLanguage
-                 , HasAttacks (attacks), creatureAttackMessage
-                 )
-import           Xanthous.Entities.Common
-                 ( wielded, Inventory, wieldedItems, WieldedItem (WieldedItem) )
-import           Xanthous.Game.State
-import           Xanthous.Game.Lenses
-                 ( entitiesCollision, collisionAt
-                 , character, characterPosition, positionIsCharacterVisible
-                 , hearingRadius
-                 )
-import           Xanthous.Data.EntityMap.Graphics (linesOfSight, canSee)
-import           Xanthous.Random
-import           Xanthous.Monad (say, message)
-import           Xanthous.Generators.Speech (word)
-import qualified Linear.Metric as Metric
-import qualified Xanthous.Messages as Messages
---------------------------------------------------------------------------------
-
---  TODO move the following two classes to a more central location
-
-class HasVisionRadius a where visionRadius :: a -> Word
-
-type IsCreature entity =
-  ( HasVisionRadius entity
-  , HasField "_hippocampus" entity entity Hippocampus Hippocampus
-  , HasField "_creatureType" entity entity CreatureType CreatureType
-  , HasField "_inventory" entity entity Inventory Inventory
-  , A.ToJSON entity
-  )
-
---------------------------------------------------------------------------------
-
-stepGormlak
-  :: forall entity m.
-    ( MonadState GameState m, MonadRandom m
-    , IsCreature entity
-    )
-  => Ticks
-  -> Positioned entity
-  -> m (Positioned entity)
-stepGormlak ticks pe@(Positioned pos creature) = do
-  canSeeCharacter <- uses entities $ canSee (entityIs @Character) pos vision
-
-  let selectDestination pos' creature' = destinationFromPos <$> do
-        if canSeeCharacter
-          then do
-            charPos <- use characterPosition
-            if isUnit (pos' `diffPositions` charPos)
-              then attackCharacter $> pos'
-              else pure $ pos' `stepTowards` charPos
-        else do
-          lines <- map (takeWhile (isNothing . entitiesCollision . map snd . snd)
-                      -- the first item on these lines is always the creature itself
-                      . fromMaybe mempty . tailMay)
-                  . linesOfSight pos' (visionRadius creature')
-                  <$> use entities
-          line <- choose $ weightedBy length lines
-          pure $ fromMaybe pos' $ fmap fst . headMay =<< line
-
-  pe' <- if canSeeCharacter && not (creature ^. creatureGreeted)
-        then yellAtCharacter $> (pe & positioned . creatureGreeted .~ True)
-        else pure pe
-
-  dest <- maybe (selectDestination pos creature) pure
-         . mfilter (\(Destination p _) -> p /= pos)
-         $ creature ^. hippocampus . destination
-  let progress' =
-        dest ^. destinationProgress
-        + creature ^. creatureType . Raw.speed . invertedRate |*| ticks
-  if progress' < 1
-    then pure
-         $ pe'
-         & positioned . hippocampus . destination
-         ?~ (dest & destinationProgress .~ progress')
-    else do
-      let newPos = dest ^. destinationPosition
-          remainingSpeed = progress' - 1
-      newDest <- selectDestination newPos creature
-                <&> destinationProgress +~ remainingSpeed
-      let pe'' = pe' & positioned . hippocampus . destination ?~ newDest
-      collisionAt newPos >>= \case
-        Nothing -> pure $ pe'' & position .~ newPos
-        Just Stop -> pure pe''
-        Just Combat -> do
-          ents <- use $ entities . atPosition newPos
-          when (any (entityIs @Character) ents) attackCharacter
-          pure pe'
-  where
-    vision = visionRadius creature
-    attackCharacter = do
-      dmg <- case creature ^? inventory . wielded . wieldedItems of
-        Just (WieldedItem item wi) -> do
-          let msg = fromMaybe
-                    (Messages.lookup ["combat", "creatureAttack", "genericWeapon"])
-                    $ wi ^. creatureAttackMessage
-          message msg $ object [ "creature" A..= creature
-                               , "item" A..= item
-                               ]
-          pure $ wi ^. Raw.damage
-        Nothing -> do
-          attack <- choose $ creature ^. creatureType . attacks
-          attackDescription <- Messages.render (attack ^. Raw.description)
-                              $ object []
-          say ["combat", "creatureAttack", "natural"]
-              $ object [ "creature" A..= creature
-                       , "attackDescription" A..= attackDescription
-                       ]
-          pure $ attack ^. Raw.damage
-
-      character %= Character.damage dmg
-
-    yellAtCharacter = for_ (creature ^. creatureType . language)
-      $ \lang -> do
-          utterance <- fmap (<> "!") . word $ getLanguage lang
-          creatureSaysText pe utterance
-
-    creatureGreeted :: Lens' entity Bool
-    creatureGreeted = hippocampus . greetedCharacter
-
-
--- | A creature sends some text
---
--- If that creature is visible to the character, its description will be
--- included, otherwise if it's within earshot the character will just hear the
--- sound
-creatureSaysText
-  :: (MonadState GameState m, MonadRandom m, IsCreature entity)
-  => Positioned entity
-  -> Text
-  -> m ()
-creatureSaysText ent txt = do
-  let entPos = ent ^. position . _Position . to (fmap fromIntegral)
-  charPos <- use $ characterPosition . _Position . to (fmap fromIntegral)
-  let dist :: Int
-      dist = round $ Metric.distance @_ @Double entPos charPos
-      audible = dist <= fromIntegral hearingRadius
-  when audible $ do
-    visible <- positionIsCharacterVisible $ ent ^. position
-    let path = ["entities", "say", "creature"]
-               <> [if visible then "visible" else "invisible"]
-        params = object [ "creature" A..= (ent ^. positioned)
-                        , "message" A..= txt
-                        ]
-    say path params
-
-newtype GormlakBrain entity = GormlakBrain { _unGormlakBrain :: entity }
-
-instance (IsCreature entity) => Brain (GormlakBrain entity) where
-  step ticks
-    = fmap (fmap GormlakBrain)
-    . stepGormlak ticks
-    . fmap _unGormlakBrain
-  entityCanMove = const True
-
-hippocampus :: HasField "_hippocampus" s t a b => Lens s t a b
-hippocampus = field @"_hippocampus"
-
-creatureType :: HasField "_creatureType" s t a b => Lens s t a b
-creatureType = field @"_creatureType"
-
-inventory :: HasField "_inventory" s t a b => Lens s t a b
-inventory = field @"_inventory"
-
---------------------------------------------------------------------------------
-
--- instance Brain Creature where
---   step = brainVia GormlakBrain
---   entityCanMove = const True
-
--- instance Entity Creature where
---   blocksVision _ = False
---   description = view $ Creature.creatureType . Raw.description
---   entityChar = view $ Creature.creatureType . char
diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs
deleted file mode 100644
index 426230cdc2fc..000000000000
--- a/users/grfn/xanthous/src/Xanthous/App.hs
+++ /dev/null
@@ -1,647 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE RecordWildCards      #-}
---------------------------------------------------------------------------------
-{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
-module Xanthous.App
-  ( makeApp
-  , RunType(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Brick hiding (App, halt, continue, raw)
-import qualified Brick
-import           Graphics.Vty.Attributes (defAttr)
-import           Graphics.Vty.Input.Events (Event(EvKey))
-import           Control.Monad.State (get, gets)
-import           Control.Monad.State.Class (modify)
-import           Data.Aeson (object, ToJSON)
-import qualified Data.Aeson as A
-import qualified Data.Vector as V
-import           System.Exit
-import           System.Directory (doesFileExist)
-import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Vector.Lens (toVectorOf)
---------------------------------------------------------------------------------
-import           Xanthous.App.Common
-import           Xanthous.App.Time
-import           Xanthous.App.Prompt
-import           Xanthous.App.Autocommands
-import           Xanthous.Command
-import           Xanthous.Data
-                 ( move
-                 , Dimensions'(Dimensions)
-                 , positioned
-                 , position
-                 , Position
-                 , (|*|)
-                 , Tiles(..), Hitpoints, fromScalar
-                 )
-import           Xanthous.Data.App (ResourceName, Panel(..), AppEvent(..))
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Data.Levels (prevLevel, nextLevel)
-import qualified Xanthous.Data.Levels as Levels
-import           Xanthous.Data.Entities (blocksObject)
-import           Xanthous.Game
-import           Xanthous.Game.State
-import           Xanthous.Game.Env
-import           Xanthous.Game.Draw (drawGame)
-import           Xanthous.Game.Prompt hiding (Fire)
-import qualified Xanthous.Messages as Messages
-import           Xanthous.Random
-import           Xanthous.Util (removeVectorIndex, useListOf)
-import           Xanthous.Util.Inflection (toSentence)
-import           Xanthous.Physics (throwDistance, bluntThrowDamage)
-import           Xanthous.Data.EntityMap.Graphics (lineOfSight)
-import           Xanthous.Data.EntityMap (EntityID)
---------------------------------------------------------------------------------
-import           Xanthous.Entities.Common
-                 ( InventoryPosition, describeInventoryPosition, backpack
-                 , wieldableItem, wieldedItems, wielded, itemsWithPosition
-                 , removeItemFromPosition, asWieldedItem
-                 , wieldedItem, items, Hand (..), describeHand, wieldInHand
-                 , WieldedItem, Wielded (..)
-                 )
-import qualified Xanthous.Entities.Character as Character
-import           Xanthous.Entities.Character hiding (pickUpItem)
-import           Xanthous.Entities.Item (Item, weight)
-import qualified Xanthous.Entities.Item as Item
-import           Xanthous.Entities.Creature (Creature)
-import qualified Xanthous.Entities.Creature as Creature
-import           Xanthous.Entities.Environment
-                 (Door, open, closed, locked, GroundMessage(..), Staircase(..))
-import           Xanthous.Entities.RawTypes
-                 ( edible, eatMessage, hitpointsHealed
-                 , attackMessage
-                 )
-import           Xanthous.Generators.Level
-import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata
-import qualified Xanthous.Generators.Level.Dungeon as Dungeon
---------------------------------------------------------------------------------
-
-type App = Brick.App GameState AppEvent ResourceName
-
-data RunType = NewGame | LoadGame FilePath
-  deriving stock (Eq)
-
-makeApp :: GameEnv -> RunType -> IO App
-makeApp env rt = pure $ Brick.App
-  { appDraw = drawGame
-  , appChooseCursor = const headMay
-  , appHandleEvent = \game event -> runAppM (handleEvent event) env game
-  , appStartEvent = case rt of
-      NewGame -> runAppM (startEvent >> get) env
-      LoadGame save -> pure . (savefile ?~ save)
-  , appAttrMap = const $ attrMap defAttr []
-  }
-
-runAppM :: AppM a -> GameEnv -> GameState -> EventM ResourceName a
-runAppM appm ge = fmap fst . runAppT appm ge
-
-startEvent :: AppM ()
-startEvent = do
-  initLevel
-  modify updateCharacterVision
-  use (character . characterName) >>= \case
-    Nothing -> prompt_ @'StringPrompt ["character", "namePrompt"] Uncancellable
-      $ \(StringResult s) -> do
-        character . characterName ?= s
-        say ["welcome"] =<< use character
-    Just n -> say ["welcome"] $ object [ "characterName" A..= n ]
-
-initLevel :: AppM ()
-initLevel = do
-  level <- genLevel 0
-  entities <>= levelToEntityMap level
-  characterPosition .= level ^. levelCharacterPosition
-
---------------------------------------------------------------------------------
-
-handleEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState)
-handleEvent ev = use promptState >>= \case
-  NoPrompt -> handleNoPromptEvent ev
-  WaitingPrompt msg pr -> handlePromptEvent msg pr ev
-
-
-handleNoPromptEvent :: BrickEvent ResourceName AppEvent -> AppM (Next GameState)
-handleNoPromptEvent (VtyEvent (EvKey k mods))
-  | Just command <- commandFromKey k mods
-  = do messageHistory %= nextTurn
-       cancelAutocommand
-       handleCommand command
-handleNoPromptEvent (AppEvent AutoContinue) = do
-  preuse (autocommand . _ActiveAutocommand . _1) >>= traverse_ autoStep
-  continue
-handleNoPromptEvent _ = continue
-
-handleCommand :: Command -> AppM (Next GameState)
-handleCommand Quit = confirm_ ["quit", "confirm"] (liftIO exitSuccess) >> continue
-
-handleCommand Help = showPanel HelpPanel >> continue
-
-handleCommand (Move dir) = do
-  newPos <- uses characterPosition $ move dir
-  collisionAt newPos >>= \case
-    Nothing -> do
-      characterPosition .= newPos
-      stepGameBy =<< uses (character . speed) (|*| Tiles 1)
-      describeEntitiesAt newPos
-    Just Combat -> attackAt newPos
-    Just Stop -> pure ()
-  continue
-
-handleCommand PickUp = do
-  pos <- use characterPosition
-  uses entities (entitiesAtPositionWithType @Item pos) >>= \case
-    [] -> say_ ["pickUp", "nothingToPickUp"]
-    [item] -> pickUpItem item
-    items' ->
-      menu_ ["pickUp", "menu"] Cancellable (entityMenu_ items')
-      $ \(MenuResult item) -> pickUpItem item
-  continue
-  where
-    pickUpItem (itemID, item) = do
-      character %= Character.pickUpItem item
-      entities . at itemID .= Nothing
-      say ["pickUp", "pickUp"] $ object [ "item" A..= item ]
-      stepGameBy 100 -- TODO
-
-handleCommand Drop = do
-  takeItemFromInventory_ ["drop", "menu"] Cancellable id
-    (say_ ["drop", "nothing"])
-    $ \(MenuResult item) -> do
-      entitiesAtCharacter %= (SomeEntity item <|)
-      say ["drop", "dropped"] $ object [ "item" A..= item ]
-  continue
-
-handleCommand PreviousMessage = do
-  messageHistory %= previousMessage
-  continue
-
-handleCommand Open = do
-  prompt_ @'DirectionPrompt ["open", "prompt"] Cancellable
-    $ \(DirectionResult dir) -> do
-      pos <- move dir <$> use characterPosition
-      doors <- uses entities $ entitiesAtPositionWithType @Door pos
-      if | null doors -> say_ ["open", "nothingToOpen"]
-         | any (view $ _2 . locked) doors -> say_ ["open", "locked"]
-         | all (view $ _2 . open) doors   -> say_ ["open", "alreadyOpen"]
-         | otherwise -> do
-             for_ doors $ \(eid, _) ->
-               entities . ix eid . positioned . _SomeEntity . open .= True
-             say_ ["open", "success"]
-      pure ()
-  stepGame -- TODO
-  continue
-
-handleCommand Close = do
-  prompt_ @'DirectionPrompt ["close", "prompt"] Cancellable
-    $ \(DirectionResult dir) -> do
-      pos <- move dir <$> use characterPosition
-      (nonDoors, doors) <- uses entities
-        $ partitionEithers
-        . toList
-        . map ( (matching . aside $ _SomeEntity @Door)
-              . over _2 (view positioned)
-              )
-        . EntityMap.atPositionWithIDs pos
-      if | null doors -> say_ ["close", "nothingToClose"]
-         | all (view $ _2 . closed) doors -> say_ ["close", "alreadyClosed"]
-         | any (view blocksObject . entityAttributes . snd) nonDoors ->
-           say ["close", "blocked"]
-           $ object [ "entityDescriptions"
-                      A..= ( toSentence
-                           . map description
-                           . filter (view blocksObject . entityAttributes)
-                           . map snd
-                           ) nonDoors
-                    , "blockOrBlocks"
-                      A..= ( if length nonDoors == 1
-                             then "blocks"
-                             else "block"
-                           :: Text)
-                    ]
-         | otherwise -> do
-             for_ doors $ \(eid, _) ->
-               entities . ix eid . positioned . _SomeEntity . closed .= True
-             for_ nonDoors $ \(eid, _) ->
-               entities . ix eid . position %= move dir
-             say_ ["close", "success"]
-      pure ()
-  stepGame -- TODO
-  continue
-
-handleCommand Look = do
-  prompt_ @'PointOnMap ["look", "prompt"] Cancellable
-    $ \(PointOnMapResult pos) -> revealedEntitiesAtPosition pos >>= \case
-        Empty -> say_ ["look", "nothing"]
-        ents -> describeEntities ents
-  continue
-
-handleCommand Wait = stepGame >> continue
-
-handleCommand Eat = do
-  uses (character . inventory . backpack)
-       (V.mapMaybe (\item -> (item,) <$> item ^. Item.itemType . edible))
-    >>= \case
-      Empty -> say_ ["eat", "noFood"]
-      food ->
-        let foodMenuItem idx (item, edibleItem)
-              = ( item ^. Item.itemType . char . char
-                , MenuOption (description item) (idx, item, edibleItem))
-                -- TODO refactor to use entityMenu_
-            menuItems = mkMenuItems $ imap foodMenuItem food
-        in menu_ ["eat", "menuPrompt"] Cancellable menuItems
-          $ \(MenuResult (idx, item, edibleItem)) -> do
-            character . inventory . backpack %= removeVectorIndex idx
-            let msg = fromMaybe (Messages.lookup ["eat", "eat"])
-                      $ edibleItem ^. eatMessage
-            character . characterHitpoints' +=
-              edibleItem ^. hitpointsHealed . to fromIntegral
-            message msg $ object ["item" A..= item]
-            stepGame -- TODO
-  continue
-
-handleCommand Read = do
-  -- TODO allow reading things in the inventory (combo direction+menu prompt?)
-  prompt_ @'DirectionPrompt ["read", "prompt"] Cancellable
-    $ \(DirectionResult dir) -> do
-      pos <- uses characterPosition $ move dir
-      uses entities
-        (fmap snd . entitiesAtPositionWithType @GroundMessage pos) >>= \case
-          Empty -> say_ ["read", "nothing"]
-          GroundMessage msg :< Empty ->
-            say ["read", "result"] $ object ["message" A..= msg]
-          msgs ->
-            let readAndContinue Empty = pure ()
-                readAndContinue (msg :< msgs') =
-                  prompt @'Continue
-                    ["read", "result"]
-                    (object ["message" A..= msg])
-                    Cancellable
-                  . const
-                  $ readAndContinue msgs'
-                readAndContinue _ = error "this is total"
-            in readAndContinue msgs
-  continue
-
-handleCommand ShowInventory = showPanel InventoryPanel >> continue
-
-handleCommand DescribeInventory = do
-  selectItemFromInventory_ ["inventory", "describe", "select"] Cancellable id
-    (say_ ["inventory", "describe", "nothing"])
-    $ \(MenuResult (invPos, item)) -> showPanel . ItemDescriptionPanel
-        $ Item.fullDescription item
-        <> "\n\n" <> describeInventoryPosition invPos
-  continue
-
-
-handleCommand Wield = do
-  hs <- use $ character . inventory . wielded
-  selectItem $ \(MenuResult (invPos, (item :: WieldedItem))) -> do
-    selectHand hs $ \(MenuResult hand) -> do
-      character . inventory
-        %= removeItemFromPosition invPos (asWieldedItem # item)
-      prevItems <- character . inventory . wielded %%= wieldInHand hand item
-      character . inventory . backpack
-        <>= fromList (map (view wieldedItem) prevItems)
-      say ["wield", "wielded"] $ object [ "item" A..= item
-                                        , "hand" A..= describeHand hand
-                                        ]
-  continue
-  where
-    selectItem =
-      selectItemFromInventory_ ["wield", "menu"] Cancellable asWieldedItem
-        (say_ ["wield", "nothing"])
-    selectHand hs = menu_ ["wield", "hand"] Cancellable $ handsMenu hs
-    itemsInHand (Hands i _) LeftHand       = toList i
-    itemsInHand (DoubleHanded _) LeftHand  = []
-    itemsInHand (Hands _ i) RightHand      = toList i
-    itemsInHand (DoubleHanded _) RightHand = []
-    itemsInHand (Hands l r) BothHands      = toList l <> toList r
-    itemsInHand (DoubleHanded i) BothHands = [i]
-    describeItems [] = ""
-    describeItems is
-      = " (currently holding "
-      <> (intercalate " and" $ map (view $ wieldedItem . to description) is)
-      <> ")"
-    handsMenu hs = mapFromList
-      . map (second $ \hand ->
-                MenuOption
-                ( describeHand hand
-                <> describeItems (itemsInHand hs hand)
-                )
-                hand
-            )
-      $ [ ('l', LeftHand)
-        , ('r', RightHand)
-        , ('b', BothHands)
-        ]
-
-handleCommand Fire = do
-  selectItemFromInventory_ ["fire", "menu"] Cancellable id
-    (say_ ["fire", "nothing"])
-    $ \(MenuResult (invPos, item)) ->
-      let wt = weight item
-          dist = throwDistance wt
-          dam = bluntThrowDamage wt
-      in if dist < fromScalar 1
-         then say_ ["fire", "zeroRange"]
-         else firePrompt_ ["fire", "target"] Cancellable dist $
-          \(FireResult targetPos) -> do
-              charPos <- use characterPosition
-              mTarget <- uses entities $ firstEnemy . lineOfSight charPos targetPos
-              case mTarget of
-                Just target -> do
-                  creature' <- damageCreature target dam
-                  unless (Creature.isDead creature') $
-                    let msgPath = ["fire", "fired"] <> [if dam == 0
-                                                        then "noDamage"
-                                                        else "someDamage"]
-                    in say msgPath $ object [ "item" A..= item
-                                            , "creature" A..= creature'
-                                            ]
-                Nothing ->
-                  say ["fire", "fired", "noTarget"] $ object [ "item" A..= item ]
-              character . inventory %= removeItemFromPosition invPos item
-              entities . EntityMap.atPosition targetPos %= (SomeEntity item <|)
-              stepGame -- TODO(grfn): should this be based on distance?
-  continue
-  where
-    firstEnemy
-      :: [(Position, Vector (EntityID, SomeEntity))]
-      -> Maybe (EntityID, Creature)
-    firstEnemy los =
-      let enemies = los >>= \(_, es) -> toList $ headMay es
-      in enemies ^? folded . below _SomeEntity
-
-handleCommand Save =
-  view (config . disableSaving) >>= \case
-    True -> say_ ["save", "disabled"] >> continue
-    False -> do
-      -- TODO default save locations / config file?
-      use savefile >>= \case
-        Just filepath ->
-          stringPromptWithDefault_
-            ["save", "location"]
-            Cancellable
-            (pack filepath)
-            promptCallback
-        Nothing -> prompt_ @'StringPrompt ["save", "location"] Cancellable promptCallback
-      continue
-      where
-        promptCallback :: PromptResult 'StringPrompt -> AppM ()
-        promptCallback (StringResult filename) = do
-          sf <- use savefile
-          exists <- liftIO . doesFileExist $ unpack filename
-          if exists && sf /= Just (unpack filename)
-          then confirm ["save", "overwrite"] (object ["filename" A..= filename])
-              $ doSave filename
-          else doSave filename
-        doSave filename = do
-          src <- gets saveGame
-          lift . liftIO $ do
-            writeFile (unpack filename) $ toStrict src
-            exitSuccess
-
-handleCommand GoUp = do
-  hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity UpStaircase)
-  if hasStairs
-  then uses levels prevLevel >>= \case
-    Just levs' -> do
-      cEID <- use characterEntityID
-      pCharacter <- entities . at cEID <<.= Nothing
-      levels .= levs'
-      charPos <- use characterPosition
-      entities . at cEID .= pCharacter
-      characterPosition .= charPos
-    Nothing ->
-      -- TODO in nethack, this leaves the game. Maybe something similar here?
-      say_ ["cant", "goUp"]
-  else say_ ["cant", "goUp"]
-
-  continue
-
-handleCommand GoDown = do
-  hasStairs <- uses entitiesAtCharacter $ elem (SomeEntity DownStaircase)
-
-  if hasStairs
-  then do
-    levs <- use levels
-    let newLevelNum = Levels.pos levs + 1
-    levs' <- nextLevel (levelToGameLevel <$> genLevel newLevelNum) levs
-    cEID <- use characterEntityID
-    pCharacter <- entities . at cEID <<.= Nothing
-    levels .= levs'
-    entities . at cEID .= pCharacter
-    characterPosition .= extract levs' ^. upStaircasePosition
-  else say_ ["cant", "goDown"]
-
-  continue
-
-handleCommand (StartAutoMove dir) = do
-  runAutocommand $ AutoMove dir
-  continue
-
-handleCommand Rest = do
-  say_ ["autocommands", "resting"]
-  runAutocommand AutoRest
-  continue
-
---
-
-handleCommand ToggleRevealAll = do
-  val <- debugState . allRevealed <%= not
-  say ["debug", "toggleRevealAll"] $ object [ "revealAll" A..= val ]
-  continue
-
---------------------------------------------------------------------------------
-attackAt :: Position -> AppM ()
-attackAt pos =
-  uses entities (entitiesAtPositionWithType @Creature pos) >>= \case
-    Empty               -> say_ ["combat", "nothingToAttack"]
-    (creature :< Empty) -> attackCreature creature
-    creatures ->
-      menu_ ["combat", "menu"] Cancellable (entityMenu_ creatures)
-      $ \(MenuResult creature) -> attackCreature creature
- where
-  attackCreature creature = do
-    charDamage <- uses character characterDamage
-    creature' <- damageCreature creature charDamage
-    unless (Creature.isDead creature') $ writeAttackMessage creature'
-    whenM (uses character $ isNothing . weapon) handleFists
-    stepGame
-  weapon chr = chr ^? inventory . wielded . wieldedItems . wieldableItem
-  writeAttackMessage creature = do
-    let params = object ["creature" A..= creature]
-    attackMessages <- uses character getAttackMessages
-    msg <- intercalate " and " <$> for attackMessages (`Messages.render` params)
-    writeMessage $ "You " <> msg
-  getAttackMessages chr =
-    case chr ^.. inventory . wielded . wieldedItems . wieldableItem of
-      [] -> [Messages.lookup ["combat", "hit", "fists"]]
-      is ->
-        is
-        <&> \wi ->
-              fromMaybe (Messages.lookup ["combat", "hit", "generic"])
-              $ wi ^. attackMessage
-
-
-  handleFists = do
-    damageChance <- use $ character . body . knuckles . to fistDamageChance
-    whenM (chance damageChance) $ do
-      damageAmount <- use $ character . body . knuckles . to fistfightingDamage
-      say_ [ "combat" , if damageAmount > 1
-                        then "fistExtraSelfDamage"
-                        else "fistSelfDamage" ]
-      character %= Character.damage damageAmount
-      character . body . knuckles %= damageKnuckles
-
-damageCreature :: (EntityID, Creature) -> Hitpoints -> AppM Creature
-damageCreature (creatureID, creature) dam = do
-  let creature' = Creature.damage dam creature
-      msgParams = object ["creature" A..= creature']
-  if Creature.isDead creature'
-    then do
-      say ["combat", "killed"] msgParams
-      floorItems <- useListOf
-                   $ entities
-                   . ix creatureID
-                   . positioned
-                   . _SomeEntity @Creature
-                   . inventory
-                   . items
-      mCreaturePos <- preuse $ entities . ix creatureID . position
-      entities . at creatureID .= Nothing
-      for_ mCreaturePos $ \creaturePos ->
-        entities . EntityMap.atPosition creaturePos
-          %= (<> fromList (SomeEntity <$> floorItems))
-    else entities . ix creatureID . positioned .= SomeEntity creature'
-  pure creature'
-
-
-entityMenu_
-  :: (Comonad w, Entity entity)
-  => [w entity]
-  -> Map Char (MenuOption (w entity))
-entityMenu_ = mkMenuItems @[_] . map entityMenuItem
-  where
-    entityMenuItem wentity
-      = let entity = extract wentity
-      in (entityMenuChar entity, MenuOption (description entity) wentity)
-
-
-entityMenuChar :: Entity a => a -> Char
-entityMenuChar entity
-  = let ec = entityChar entity ^. char
-    in if ec `elem` (['a'..'z'] ++ ['A'..'Z'])
-        then ec
-        else 'a'
-
--- | Prompt with an item to select out of the inventory and call callback with
--- it
-selectItemFromInventory
-  :: forall item params.
-    (ToJSON params)
-  => [Text]            -- ^ Menu message
-  -> params            -- ^ Menu message params
-  -> PromptCancellable -- ^ Is the menu cancellable?
-  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
-                      --   recoverable fashion. Prism vs iso so we can discard
-                      --   items.
-  -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ())
-  -> AppM ()
-selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb = do
-  uses (character . inventory)
-       (V.mapMaybe (_2 $ preview extraInfo) . toVectorOf itemsWithPosition)
-    >>= \case
-      Empty -> onEmpty
-      items' -> menu msgPath msgParams cancellable (itemMenu items') cb
-  where
-    itemMenu = mkMenuItems . map itemMenuItem
-    itemMenuItem (invPos, extraInfoItem) =
-      let item = extraInfo # extraInfoItem
-      in ( entityMenuChar item
-         , MenuOption
-           (description item <> " (" <> describeInventoryPosition invPos <> ")")
-           (invPos, extraInfoItem)
-         )
-
--- | Prompt with an item to select out of the inventory and call callback with
--- it
-selectItemFromInventory_
-  :: forall item.
-    [Text]            -- ^ Menu message
-  -> PromptCancellable -- ^ Is the menu cancellable?
-  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
-                      --   recoverable fashion. Prism vs iso so we can discard
-                      --   items.
-  -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu (InventoryPosition, item)) -> AppM ())
-  -> AppM ()
-selectItemFromInventory_ msgPath = selectItemFromInventory msgPath ()
-
--- | Prompt with an item to select out of the inventory, remove it from the
--- inventory, and call callback with it
-takeItemFromInventory
-  :: forall item params.
-    (ToJSON params)
-  => [Text]            -- ^ Menu message
-  -> params            -- ^ Menu message params
-  -> PromptCancellable -- ^ Is the menu cancellable?
-  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
-                      --   recoverable fashion. Prism vs iso so we can discard
-                      --   items.
-  -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu item) -> AppM ())
-  -> AppM ()
-takeItemFromInventory msgPath msgParams cancellable extraInfo onEmpty cb =
-  selectItemFromInventory msgPath msgParams cancellable extraInfo onEmpty
-    $ \(MenuResult (invPos, item)) -> do
-      character . inventory
-        %= removeItemFromPosition invPos (item ^. re extraInfo)
-      cb $ MenuResult item
-
-takeItemFromInventory_
-  :: forall item.
-    [Text]            -- ^ Menu message
-  -> PromptCancellable -- ^ Is the menu cancellable?
-  -> Prism' Item item  -- ^ Attach some extra information to the item, in a
-                      --   recoverable fashion. Prism vs iso so we can discard
-                      --   items.
-  -> AppM ()            -- ^ Action to take if there are no items matching
-  -> (PromptResult ('Menu item) -> AppM ())
-  -> AppM ()
-takeItemFromInventory_ msgPath = takeItemFromInventory msgPath ()
-
--- entityMenu :: Entity entity => [entity] -> Map Char (MenuOption entity)
--- entityMenu = map (map runIdentity) . entityMenu_ . fmap Identity
-
-showPanel :: Panel -> AppM ()
-showPanel panel = do
-  activePanel ?= panel
-  prompt_ @'Continue ["generic", "continue"] Uncancellable
-    . const
-    $ activePanel .= Nothing
-
---------------------------------------------------------------------------------
-
-genLevel
-  :: Word -- ^ Level number, starting at 0
-  -> AppM Level
-genLevel num = do
-  let dims = Dimensions 80 80
-  generator <- choose $ CaveAutomata :| [Dungeon]
-  let
-    doGen = case generator of
-      CaveAutomata -> generateLevel SCaveAutomata CaveAutomata.defaultParams
-      Dungeon -> generateLevel SDungeon Dungeon.defaultParams
-  level <- doGen dims num
-  pure $!! level
-
-levelToGameLevel :: Level -> GameLevel
-levelToGameLevel level =
-  let _levelEntities = levelToEntityMap level
-      _upStaircasePosition = level ^. levelCharacterPosition
-      _levelRevealedPositions = mempty
-  in GameLevel {..}
diff --git a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs b/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs
deleted file mode 100644
index 5d4db1a47465..000000000000
--- a/users/grfn/xanthous/src/Xanthous/App/Autocommands.hs
+++ /dev/null
@@ -1,76 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.App.Autocommands
-  ( runAutocommand
-  , autoStep
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Control.Concurrent (threadDelay)
-import qualified Data.Aeson as A
-import           Data.Aeson (object)
-import           Data.List.NonEmpty (nonEmpty)
-import qualified Data.List.NonEmpty as NE
-import           Control.Monad.State (gets)
---------------------------------------------------------------------------------
-import           Xanthous.App.Common
-import           Xanthous.App.Time
-import           Xanthous.Data
-import           Xanthous.Data.App
-import           Xanthous.Entities.Character (speed, isFullyHealed)
-import           Xanthous.Entities.Creature (Creature, creatureType)
-import           Xanthous.Entities.RawTypes (hostile)
-import           Xanthous.Game.State
---------------------------------------------------------------------------------
-
--- | Step the given autocommand forward once
-autoStep :: Autocommand -> AppM ()
-autoStep (AutoMove dir) = do
-  newPos <- uses characterPosition $ move dir
-  collisionAt newPos >>= \case
-    Nothing -> do
-      characterPosition .= newPos
-      stepGameBy =<< uses (character . speed) (|*| (1 :: Tiles))
-      describeEntitiesAt newPos
-      cancelIfDanger
-    Just _ -> cancelAutocommand
-
-autoStep AutoRest = do
-  done <- uses character isFullyHealed
-  if done
-    then say_ ["autocommands", "doneResting"] >> cancelAutocommand
-    else stepGame >> cancelIfDanger
-
--- | Cancel the autocommand if the character is in danger
-cancelIfDanger :: AppM ()
-cancelIfDanger = do
-  maybeVisibleEnemies <- nonEmpty <$> enemiesInSight
-  for_ maybeVisibleEnemies $ \visibleEnemies -> do
-    say ["autocommands", "enemyInSight"]
-      $ object [ "firstEntity" A..= NE.head visibleEnemies ]
-    cancelAutocommand
-  where
-    enemiesInSight :: AppM [Creature]
-    enemiesInSight = do
-      ents <- gets characterVisibleEntities
-      pure $ ents
-          ^.. folded
-            . _SomeEntity @Creature
-            . filtered (view $ creatureType . hostile)
-
---------------------------------------------------------------------------------
-
-autocommandIntervalμs :: Int
-autocommandIntervalμs = 1000 * 50 -- 50 ms
-
-runAutocommand :: Autocommand -> AppM ()
-runAutocommand ac = do
-  env <- ask
-  tid <- liftIO . async $ runReaderT go env
-  autocommand .= ActiveAutocommand ac tid
-  where
-    go = everyμs autocommandIntervalμs $ sendEvent AutoContinue
-
--- | Perform 'act' every μs microseconds forever
-everyμs :: MonadIO m => Int -> m () -> m ()
-everyμs μs act = act >> liftIO (threadDelay μs) >> everyμs μs act
diff --git a/users/grfn/xanthous/src/Xanthous/App/Common.hs b/users/grfn/xanthous/src/Xanthous/App/Common.hs
deleted file mode 100644
index 69ba6f0e0596..000000000000
--- a/users/grfn/xanthous/src/Xanthous/App/Common.hs
+++ /dev/null
@@ -1,67 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.App.Common
-  ( describeEntities
-  , describeEntitiesAt
-  , entitiesAtPositionWithType
-
-    -- * Re-exports
-  , MonadState
-  , MonadRandom
-  , EntityMap
-  , module Xanthous.Game.Lenses
-  , module Xanthous.Monad
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson (object)
-import qualified Data.Aeson as A
-import           Control.Monad.State (MonadState)
-import           Control.Monad.Random (MonadRandom)
---------------------------------------------------------------------------------
-import           Xanthous.Data (Position, positioned)
-import           Xanthous.Data.EntityMap (EntityMap)
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Game
-import           Xanthous.Game.Lenses
-import           Xanthous.Game.State
-import           Xanthous.Monad
-import           Xanthous.Entities.Character (Character)
-import           Xanthous.Util.Inflection (toSentence)
---------------------------------------------------------------------------------
-
-entitiesAtPositionWithType
-  :: forall a. (Entity a, Typeable a)
-  => Position
-  -> EntityMap SomeEntity
-  -> [(EntityMap.EntityID, a)]
-entitiesAtPositionWithType pos em =
-  let someEnts = EntityMap.atPositionWithIDs pos em
-  in flip foldMap someEnts $ \(eid, view positioned -> se) ->
-    case downcastEntity @a se of
-      Just e  -> [(eid, e)]
-      Nothing -> []
-
-describeEntitiesAt :: (MonadState GameState m, MonadRandom m) => Position -> m ()
-describeEntitiesAt pos =
-  use ( entities
-      . EntityMap.atPosition pos
-      . to (filter (not . entityIs @Character))
-      ) >>= \case
-        Empty -> pure ()
-        ents  -> describeEntities ents
-
-describeEntities
-  :: ( Entity entity
-    , MonadRandom m
-    , MonadState GameState m
-    , MonoFoldable (f Text)
-    , Functor f
-    , Element (f Text) ~ Text
-    )
-  => f entity
-  -> m ()
-describeEntities ents =
-  let descriptions = description <$> ents
-  in say ["entities", "description"]
-     $ object ["entityDescriptions" A..= toSentence descriptions]
diff --git a/users/grfn/xanthous/src/Xanthous/App/Prompt.hs b/users/grfn/xanthous/src/Xanthous/App/Prompt.hs
deleted file mode 100644
index 799281a1c2fd..000000000000
--- a/users/grfn/xanthous/src/Xanthous/App/Prompt.hs
+++ /dev/null
@@ -1,228 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
---------------------------------------------------------------------------------
-module Xanthous.App.Prompt
-  ( handlePromptEvent
-  , clearPrompt
-  , prompt
-  , prompt_
-  , stringPromptWithDefault
-  , stringPromptWithDefault_
-  , confirm_
-  , confirm
-  , menu
-  , menu_
-  , firePrompt_
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Brick (BrickEvent(..), Next)
-import           Brick.Widgets.Edit (handleEditorEvent)
-import           Data.Aeson (ToJSON, object)
-import           Graphics.Vty.Input.Events (Event(EvKey), Key(..))
---------------------------------------------------------------------------------
-import           Xanthous.App.Common
-import           Xanthous.Data (move, Tiles, Position, positioned, _Position)
-import qualified Xanthous.Data as Data
-import           Xanthous.Command (directionFromChar)
-import           Xanthous.Data.App (ResourceName, AppEvent)
-import           Xanthous.Game.Prompt
-import           Xanthous.Game.State
-import qualified Xanthous.Messages as Messages
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Creature (creatureType, Creature)
-import           Xanthous.Entities.RawTypes (hostile)
-import qualified Linear.Metric as Metric
---------------------------------------------------------------------------------
-
-handlePromptEvent
-  :: Text -- ^ Prompt message
-  -> Prompt AppM
-  -> BrickEvent ResourceName AppEvent
-  -> AppM (Next GameState)
-
-handlePromptEvent _ (Prompt Cancellable _ _ _ _) (VtyEvent (EvKey KEsc []))
-  = clearPrompt >> continue
-handlePromptEvent _ pr (VtyEvent (EvKey KEnter []))
-  = clearPrompt >> submitPrompt pr >> continue
-
-handlePromptEvent _ pr@(Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'y') []))
-  = clearPrompt >> submitPrompt pr >> continue
-
-handlePromptEvent _ (Prompt _ SConfirm _ _ _) (VtyEvent (EvKey (KChar 'n') []))
-  = clearPrompt >> continue
-
-handlePromptEvent
-  msg
-  (Prompt c SStringPrompt (StringPromptState edit) pri cb)
-  (VtyEvent ev)
-  = do
-    edit' <- lift $ handleEditorEvent ev edit
-    let prompt' = Prompt c SStringPrompt (StringPromptState edit') pri cb
-    promptState .= WaitingPrompt msg prompt'
-    continue
-
-handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ cb)
-  (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
-  = clearPrompt >> cb (DirectionResult dir) >> continue
-handlePromptEvent _ (Prompt _ SDirectionPrompt _ _ _) _ = continue
-
-handlePromptEvent _ (Prompt _ SMenu _ items' cb) (VtyEvent (EvKey (KChar chr) []))
-  | Just (MenuOption _ res) <- items' ^. at chr
-  = clearPrompt >> cb (MenuResult res) >> continue
-  | otherwise
-  = continue
-
-handlePromptEvent
-  msg
-  (Prompt c SPointOnMap (PointOnMapPromptState pos) pri cb)
-  (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
-  = let pos' = move dir pos
-        prompt' = Prompt c SPointOnMap (PointOnMapPromptState pos') pri cb
-    in promptState .= WaitingPrompt msg prompt'
-       >> continue
-handlePromptEvent _ (Prompt _ SPointOnMap _ _ _) _ = continue
-
-handlePromptEvent
-  msg
-  (Prompt c SFire (FirePromptState pos) pri@(origin, range) cb)
-  (VtyEvent (EvKey (KChar (directionFromChar -> Just dir)) []))
-  = do
-  let pos' = move dir pos
-      prompt' = Prompt c SFire (FirePromptState pos') pri cb
-  when (Data.distance origin pos' <= range) $
-    promptState .= WaitingPrompt msg prompt'
-  continue
-
-handlePromptEvent
-  _
-  (Prompt Cancellable _ _ _ _)
-  (VtyEvent (EvKey (KChar 'q') []))
-  = clearPrompt >> continue
-handlePromptEvent _ _ _ = continue
-
-clearPrompt :: AppM ()
-clearPrompt = promptState .= NoPrompt
-
-type PromptParams :: PromptType -> Type
-type family PromptParams pt where
-  PromptParams ('Menu a) = Map Char (MenuOption a) -- Menu items
-  PromptParams 'Fire     = Tiles -- Range
-  PromptParams _         = ()
-
-prompt
-  :: forall (pt :: PromptType) (params :: Type).
-    (ToJSON params, SingPromptType pt, PromptParams pt ~ ())
-  => [Text]                     -- ^ Message key
-  -> params                     -- ^ Message params
-  -> PromptCancellable
-  -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler
-  -> AppM ()
-prompt msgPath params cancellable cb = do
-  let pt = singPromptType @pt
-  msg <- Messages.message msgPath params
-  mp :: Maybe (Prompt AppM) <- case pt of
-    SPointOnMap -> do
-      charPos <- use characterPosition
-      pure . Just $ mkPointOnMapPrompt cancellable charPos cb
-    SStringPrompt -> pure . Just $ mkStringPrompt cancellable cb
-    SConfirm -> pure . Just $ mkPrompt cancellable pt cb
-    SDirectionPrompt -> pure . Just $ mkPrompt cancellable pt cb
-    SContinue -> pure . Just $ mkPrompt cancellable pt cb
-  for_ mp $ \p -> promptState .= WaitingPrompt msg p
-
-prompt_
-  :: forall (pt :: PromptType).
-    (SingPromptType pt, PromptParams pt ~ ())
-  => [Text] -- ^ Message key
-  -> PromptCancellable
-  -> (PromptResult pt -> AppM ()) -- ^ Prompt promise handler
-  -> AppM ()
-prompt_ msg = prompt msg $ object []
-
-stringPromptWithDefault
-  :: forall (params :: Type). (ToJSON params)
-  => [Text]                                -- ^ Message key
-  -> params                                -- ^ Message params
-  -> PromptCancellable
-  -> Text                                  -- ^ Prompt default
-  -> (PromptResult 'StringPrompt -> AppM ()) -- ^ Prompt promise handler
-  -> AppM ()
-stringPromptWithDefault msgPath params cancellable def cb = do
-  msg <- Messages.message msgPath params
-  let p = mkStringPromptWithDefault cancellable def cb
-  promptState .= WaitingPrompt msg p
-
-stringPromptWithDefault_
-  :: [Text]                                -- ^ Message key
-  -> PromptCancellable
-  -> Text                                  -- ^ Prompt default
-  -> (PromptResult 'StringPrompt -> AppM ()) -- ^ Prompt promise handler
-  -> AppM ()
-stringPromptWithDefault_ msg = stringPromptWithDefault msg $ object []
-
-confirm
-  :: ToJSON params
-  => [Text] -- ^ Message key
-  -> params
-  -> AppM ()
-  -> AppM ()
-confirm msgPath params
-  = prompt @'Confirm msgPath params Cancellable . const
-
-confirm_ :: [Text] -> AppM () -> AppM ()
-confirm_ msgPath = confirm msgPath $ object []
-
-menu :: forall (a :: Type) (params :: Type).
-       (ToJSON params)
-     => [Text]                            -- ^ Message key
-     -> params                            -- ^ Message params
-     -> PromptCancellable
-     -> Map Char (MenuOption a)           -- ^ Menu items
-     -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler
-     -> AppM ()
-menu msgPath params cancellable items' cb = do
-  msg <- Messages.message msgPath params
-  let p = mkMenu cancellable items' cb
-  promptState .= WaitingPrompt msg p
-
-menu_ :: forall (a :: Type).
-        [Text]                            -- ^ Message key
-      -> PromptCancellable
-      -> Map Char (MenuOption a)           -- ^ Menu items
-      -> (PromptResult ('Menu a) -> AppM ()) -- ^ Menu promise handler
-      -> AppM ()
-menu_ msgPath = menu msgPath $ object []
-
-firePrompt_
-  :: [Text]                        -- ^ Message key
-  -> PromptCancellable
-  -> Tiles                         -- ^ Range
-  -> (PromptResult 'Fire -> AppM ()) -- ^ Promise handler
-  -> AppM ()
-firePrompt_ msgPath cancellable range cb = do
-  msg <- Messages.message msgPath $ object []
-  initialPos <- maybe (use characterPosition) pure =<< nearestEnemyPosition
-  let p = mkFirePrompt cancellable initialPos range cb
-  promptState .= WaitingPrompt msg p
-
--- | Returns the position of the nearest visible hostile creature, if any
-nearestEnemyPosition :: AppM (Maybe Position)
-nearestEnemyPosition = do
-  charPos <- use characterPosition
-  em <- use entities
-  ps <- characterVisiblePositions
-  let candidates = toList ps >>= \p ->
-        let ents = EntityMap.atPositionWithIDs p em
-        in ents
-           ^.. folded
-           . _2
-           . positioned
-           . _SomeEntity @Creature
-           . creatureType
-           . filtered (view hostile)
-           . to (const (distance charPos p, p))
-  pure . headMay . fmap snd $ sortOn fst candidates
-  where
-    distance :: Position -> Position -> Double
-    distance = Metric.distance `on` (fmap fromIntegral . view _Position)
diff --git a/users/grfn/xanthous/src/Xanthous/App/Time.hs b/users/grfn/xanthous/src/Xanthous/App/Time.hs
deleted file mode 100644
index cca352858d9c..000000000000
--- a/users/grfn/xanthous/src/Xanthous/App/Time.hs
+++ /dev/null
@@ -1,42 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.App.Time
-  ( stepGame
-  , stepGameBy
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           System.Exit
---------------------------------------------------------------------------------
-import           Xanthous.Data (Ticks)
-import           Xanthous.App.Prompt
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Character (isDead)
-import           Xanthous.Game.State
-import           Xanthous.Game.Prompt
-import           Xanthous.Game.Lenses
-import           Control.Monad.State (modify)
-import qualified Xanthous.Game.Memo as Memo
---------------------------------------------------------------------------------
-
-
-stepGameBy :: Ticks -> AppM ()
-stepGameBy ticks = do
-  ents <- uses entities EntityMap.toEIDsAndPositioned
-  for_ ents $ \(eid, pEntity) -> do
-    pEntity' <- step ticks pEntity
-    entities . ix eid .= pEntity'
-
-  clearMemo Memo.characterVisiblePositions
-  modify updateCharacterVision
-
-  whenM (uses character isDead)
-    . prompt_ @'Continue ["dead"] Uncancellable
-    . const . lift . liftIO
-    $ exitSuccess
-
-ticksPerTurn :: Ticks
-ticksPerTurn = 100
-
-stepGame :: AppM ()
-stepGame = stepGameBy ticksPerTurn
diff --git a/users/grfn/xanthous/src/Xanthous/Command.hs b/users/grfn/xanthous/src/Xanthous/Command.hs
deleted file mode 100644
index 6e6274a02c6f..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Command.hs
+++ /dev/null
@@ -1,145 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Command
-  ( -- * Commands
-    Command(..)
-  , commandIsHidden
-    -- * Keybindings
-  , Keybinding(..)
-  , keybindings
-  , commands
-  , commandFromKey
-  , directionFromChar
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (Left, Right, Down, try)
---------------------------------------------------------------------------------
-import           Graphics.Vty.Input (Key(..), Modifier(..))
-import qualified Data.Char as Char
-import           Data.Aeson (FromJSON (parseJSON), FromJSONKey, FromJSONKeyFunction (FromJSONKeyTextParser))
-import qualified Data.Aeson as A
-import           Data.Aeson.Generic.DerivingVia
-import           Text.Megaparsec (Parsec, errorBundlePretty, parse, eof, try)
-import           Text.Megaparsec.Char (string', char', printChar)
-import           Data.FileEmbed (embedFile)
-import qualified Data.Yaml as Yaml
-import           Test.QuickCheck.Arbitrary
-import           Data.Aeson.Types (Parser)
---------------------------------------------------------------------------------
-import           Xanthous.Data (Direction(..))
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
---------------------------------------------------------------------------------
-
-data Command
-  = Quit
-  | Help
-  | Move !Direction
-  | StartAutoMove !Direction
-  | PreviousMessage
-  | PickUp
-  | Drop
-  | Open
-  | Close
-  | Wait
-  | Eat
-  | Look
-  | Save
-  | Read
-  | ShowInventory
-  | DescribeInventory
-  | Wield
-  | Fire
-  | GoUp
-  | GoDown
-  | Rest
-
-    -- | TODO replace with `:` commands
-  | ToggleRevealAll
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (Hashable, NFData)
-  deriving Arbitrary via GenericArbitrary Command
-  deriving (FromJSON)
-       via WithOptions '[ SumEnc UntaggedVal ]
-           Command
-
--- | Should the command be hidden from the help menu?
---
--- Note that this is true for both debug commands and movement commands, as the
--- latter is documented non-automatically
-commandIsHidden :: Command -> Bool
-commandIsHidden (Move _) = True
-commandIsHidden (StartAutoMove _) = True
-commandIsHidden ToggleRevealAll = True
-commandIsHidden _ = False
-
---------------------------------------------------------------------------------
-
-data Keybinding = Keybinding !Key ![Modifier]
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (Hashable, NFData)
-
-parseKeybindingFromText :: Text -> Parser Keybinding
-parseKeybindingFromText
-  = either (fail . errorBundlePretty) pure
-  . parse keybinding "<JSON>"
-  where
-    key :: Parsec Void Text Key
-    key = KUp <$ string' "<up>"
-      <|> KDown <$ string' "<down>"
-      <|> KLeft <$ string' "<left>"
-      <|> KRight <$ string' "<right>"
-      <|> KChar <$> printChar
-
-    modifier :: Parsec Void Text Modifier
-    modifier = modf <* char' '-'
-      where
-        modf = MAlt <$ char' 'a'
-          <|> MMeta <$ char' 'm'
-          <|> MCtrl  <$ char' 'c'
-          <|> MShift  <$ char' 's'
-
-    keybinding :: Parsec Void Text Keybinding
-    keybinding = do
-      mods <- many (try modifier)
-      k <- key
-      eof
-      pure $ Keybinding k mods
-
-instance FromJSON Keybinding where
-  parseJSON = A.withText "Keybinding" parseKeybindingFromText
-
-instance FromJSONKey Keybinding where
-  fromJSONKey = FromJSONKeyTextParser parseKeybindingFromText
-
-rawKeybindings :: ByteString
-rawKeybindings = $(embedFile "src/Xanthous/keybindings.yaml")
-
-keybindings :: HashMap Keybinding Command
-keybindings = either (error . Yaml.prettyPrintParseException) id
-  $ Yaml.decodeEither' rawKeybindings
-
-commands :: HashMap Command Keybinding
-commands = mapFromList . map swap . itoList $ keybindings
-
-commandFromKey :: Key -> [Modifier] -> Maybe Command
-commandFromKey (KChar (directionFromChar -> Just dir)) [] = Just $ Move dir
-commandFromKey (KChar c) []
-  | Char.isUpper c
-  , Just dir <- directionFromChar $ Char.toLower c
-  = Just $ StartAutoMove dir
-commandFromKey k mods = keybindings ^. at keybinding
-  where keybinding = Keybinding k mods
-
---------------------------------------------------------------------------------
-
-directionFromChar :: Char -> Maybe Direction
-directionFromChar 'h' = Just Left
-directionFromChar 'j' = Just Down
-directionFromChar 'k' = Just Up
-directionFromChar 'l' = Just Right
-directionFromChar 'y' = Just UpLeft
-directionFromChar 'u' = Just UpRight
-directionFromChar 'b' = Just DownLeft
-directionFromChar 'n' = Just DownRight
-directionFromChar '.' = Just Here
-directionFromChar _   = Nothing
diff --git a/users/grfn/xanthous/src/Xanthous/Data.hs b/users/grfn/xanthous/src/Xanthous/Data.hs
deleted file mode 100644
index 703955206a7e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data.hs
+++ /dev/null
@@ -1,822 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures  #-}
-{-# LANGUAGE StandaloneDeriving     #-}
-{-# LANGUAGE RoleAnnotations        #-}
-{-# LANGUAGE RecordWildCards        #-}
-{-# LANGUAGE DeriveTraversable      #-}
-{-# LANGUAGE TemplateHaskell        #-}
-{-# LANGUAGE NoTypeSynonymInstances #-}
-{-# LANGUAGE DuplicateRecordFields  #-}
-{-# LANGUAGE QuantifiedConstraints  #-}
-{-# LANGUAGE UndecidableInstances   #-}
-{-# LANGUAGE AllowAmbiguousTypes    #-}
---------------------------------------------------------------------------------
--- | Common data types for Xanthous ------------------------------------------------------------------------------
-module Xanthous.Data
-  ( Opposite(..)
-
-    -- *
-  , Position'(..)
-  , Position
-  , x
-  , y
-
-    -- **
-  , Positioned(..)
-  , _Positioned
-  , position
-  , positioned
-  , loc
-  , _Position
-  , positionFromPair
-  , positionFromV2
-  , addPositions
-  , diffPositions
-  , stepTowards
-  , isUnit
-  , distance
-
-    -- * Boxes
-  , Box(..)
-  , topLeftCorner
-  , bottomRightCorner
-  , setBottomRightCorner
-  , dimensions
-  , inBox
-  , boxIntersects
-  , boxCenter
-  , boxEdge
-  , module Linear.V2
-
-    -- * Unit math
-  , Scalar(..)
-  , Per(..)
-  , invertRate
-  , invertedRate
-  , (|+|)
-  , (|*|)
-  , (|/|)
-  , (:+:)
-  , (:*:)
-  , (:/:)
-  , (:**:)(..)
-  , Ticks(..)
-  , Tiles(..)
-  , TicksPerTile
-  , TilesPerTick
-  , timesTiles
-  , Square(..)
-  , squared
-  , Cubic(..)
-  , Grams
-  , Meters
-  , Uno(..)
-  , Unit(..)
-  , UnitSymbol(..)
-
-    -- *
-  , Dimensions'(..)
-  , Dimensions
-  , HasWidth(..)
-  , HasHeight(..)
-
-    -- *
-  , Direction(..)
-  , move
-  , asPosition
-  , directionOf
-  , Cardinal(..)
-
-    -- *
-  , Corner(..)
-  , Edge(..)
-  , cornerEdges
-
-    -- *
-  , Neighbors(..)
-  , edges
-  , neighborDirections
-  , neighborPositions
-  , neighborCells
-  , arrayNeighbors
-  , rotations
-  , HasTopLeft(..)
-  , HasTop(..)
-  , HasTopRight(..)
-  , HasLeft(..)
-  , HasRight(..)
-  , HasBottomLeft(..)
-  , HasBottom(..)
-  , HasBottomRight(..)
-
-    -- *
-  , Hitpoints(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (Left, Down, Right, (.=), elements)
---------------------------------------------------------------------------------
-import           Linear.V2 hiding (_x, _y)
-import qualified Linear.V2 as L
-import           Linear.V4 hiding (_x, _y)
-import           Test.QuickCheck (CoArbitrary, Function, elements)
-import           Test.QuickCheck.Arbitrary.Generic
-import           Data.Group
-import           Brick (Location(Location), Edges(..))
-import           Data.Monoid (Product(..), Sum(..))
-import           Data.Array.IArray
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson
-                 ( ToJSON(..), FromJSON(..), object, (.=), (.:), withObject)
-import           Data.Random (Distribution)
-import           Data.Coerce
-import           Data.Proxy (Proxy(Proxy))
---------------------------------------------------------------------------------
-import           Xanthous.Util (EqEqProp(..), EqProp, between)
-import           Xanthous.Orphans ()
-import           Xanthous.Util.Graphics
-import qualified Linear.Metric as Metric
---------------------------------------------------------------------------------
-
--- | opposite ∘ opposite ≡ id
-class Opposite x where
-  opposite :: x -> x
-
---------------------------------------------------------------------------------
-
--- fromScalar ∘ scalar ≡ id
-class Scalar a where
-  scalar :: a -> Double
-  fromScalar :: Double -> a
-
-instance Scalar Double where
-  scalar = id
-  fromScalar = id
-
-newtype ScalarIntegral a = ScalarIntegral a
-  deriving newtype (Eq, Ord, Num, Enum, Real, Integral)
-instance Integral a => Scalar (ScalarIntegral a) where
-  scalar = fromIntegral
-  fromScalar = floor
-
-deriving via (ScalarIntegral Integer) instance Scalar Integer
-deriving via (ScalarIntegral Word) instance Scalar Word
-
--- | Units of measure
-class Unit a where
-  unitSuffix :: Text
-type UnitSymbol :: Symbol -> Type -> Type
-newtype UnitSymbol suffix a = UnitSymbol a
-instance KnownSymbol suffix => Unit (UnitSymbol suffix a) where
-  unitSuffix = pack $ symbolVal @suffix Proxy
-
-newtype ShowUnitSuffix a b = ShowUnitSuffix a
-instance (Show b, Unit a, Coercible a b) => Show (ShowUnitSuffix a b) where
-  show a = show (coerce @_ @b a) <> " " <> unpack (unitSuffix @a)
-
---------------------------------------------------------------------------------
-
-data Position' a where
-  Position :: { _x :: a
-             , _y :: a
-             } -> (Position' a)
-  deriving stock (Show, Eq, Generic, Ord, Functor, Foldable, Traversable)
-  deriving anyclass (NFData, Hashable, CoArbitrary, Function)
-  deriving EqProp via EqEqProp (Position' a)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       (Position' a)
-
-x, y :: Lens' (Position' a) a
-x = lens (\(Position xx _) -> xx) (\(Position _ yy) xx -> Position xx yy)
-y = lens (\(Position _ yy) -> yy) (\(Position xx _) yy -> Position xx yy)
-
-type Position = Position' Int
-
-instance (Arbitrary a) => Arbitrary (Position' a) where
-  arbitrary = genericArbitrary
-  shrink (Position px py) = Position <$> shrink px <*> shrink py
-
-
-instance Num a => Semigroup (Position' a) where
-  (Position x₁ y₁) <> (Position x₂ y₂) = Position (x₁ + x₂) (y₁ + y₂)
-
-instance Num a => Monoid (Position' a) where
-  mempty = Position 0 0
-
-instance Num a => Group (Position' a) where
-  invert (Position px py) = Position (negate px) (negate py)
-
--- | Positions convert to scalars by discarding their orientation and just
--- measuring the length from the origin
-instance (Ord a, Num a, Scalar a) => Scalar (Position' a) where
-  scalar = fromIntegral . length . line 0 . view _Position
-  fromScalar n = Position (fromScalar n) (fromScalar n)
-
-data Positioned a where
-  Positioned :: Position -> a -> Positioned a
-  deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-type role Positioned representational
-
-_Positioned :: Iso (Position, a) (Position, b) (Positioned a) (Positioned b)
-_Positioned = iso hither yon
-  where
-    hither (pos, a) = Positioned pos a
-    yon (Positioned pos b) = (pos, b)
-
-instance Arbitrary a => Arbitrary (Positioned a) where
-  arbitrary = Positioned <$> arbitrary <*> arbitrary
-
-instance ToJSON a => ToJSON (Positioned a) where
-  toJSON (Positioned pos val) = object
-    [ "position" .= pos
-    , "data" .= val
-    ]
-
-instance FromJSON a => FromJSON (Positioned a) where
-  parseJSON = withObject "Positioned" $ \obj ->
-    Positioned <$> obj .: "position" <*> obj .: "data"
-
-position :: Lens' (Positioned a) Position
-position = lens
-  (\(Positioned pos _) -> pos)
-  (\(Positioned _ a) pos -> Positioned pos a)
-
-positioned :: Lens (Positioned a) (Positioned b) a b
-positioned = lens
-  (\(Positioned _ x') -> x')
-  (\(Positioned pos _) x' -> Positioned pos x')
-
-loc :: Iso' Position Location
-loc = iso hither yon
-  where
-    hither (Position px py) = Location (px, py)
-    yon (Location (lx, ly)) = Position lx ly
-
-_Position :: Iso' (Position' a) (V2 a)
-_Position = iso hither yon
-  where
-    hither (Position px py) = V2 px py
-    yon (V2 lx ly) = Position lx ly
-
-positionFromPair :: (Num a, Integral i, Integral j) => (i, j) -> Position' a
-positionFromPair (i, j) = Position (fromIntegral i) (fromIntegral j)
-
-positionFromV2 :: (Num a, Integral i) => V2 i -> Position' a
-positionFromV2 (V2 xx yy) = Position (fromIntegral xx) (fromIntegral yy)
-
--- | Add two positions
---
--- Operation for the additive group on positions
-addPositions :: Num a => Position' a -> Position' a -> Position' a
-addPositions = (<>)
-
--- | Subtract two positions.
---
--- diffPositions pos₁ pos₂ = pos₁ `addPositions` (invert pos₂)
-diffPositions :: Num a => Position' a -> Position' a -> Position' a
-diffPositions (Position x₁ y₁) (Position x₂ y₂) = Position (x₁ - x₂) (y₁ - y₂)
-
--- | Is this position a unit position? or: When taken as a difference, does this
--- position represent a step of one tile?
---
--- ∀ dir :: Direction. isUnit ('asPosition' dir)
-isUnit :: (Eq a, Num a) => Position' a -> Bool
-isUnit (Position px py) =
-  abs px `elem` [0,1] && abs py `elem` [0, 1] && (px, py) /= (0, 0)
-
---------------------------------------------------------------------------------
-
-data Dimensions' a = Dimensions
-  { _width :: a
-  , _height :: a
-  }
-  deriving stock (Show, Eq, Functor, Generic)
-  deriving anyclass (CoArbitrary, Function)
-makeFieldsNoPrefix ''Dimensions'
-
-instance Arbitrary a => Arbitrary (Dimensions' a) where
-  arbitrary = Dimensions <$> arbitrary <*> arbitrary
-
-type Dimensions = Dimensions' Word
-
---------------------------------------------------------------------------------
-
-data Direction where
-  Up        :: Direction
-  Down      :: Direction
-  Left      :: Direction
-  Right     :: Direction
-  UpLeft    :: Direction
-  UpRight   :: Direction
-  DownLeft  :: Direction
-  DownRight :: Direction
-  Here      :: Direction
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (CoArbitrary, Function, NFData, ToJSON, FromJSON, Hashable)
-
-deriving via (GenericArbitrary Direction) instance Arbitrary Direction
-
-instance Opposite Direction where
-  opposite Up        = Down
-  opposite Down      = Up
-  opposite Left      = Right
-  opposite Right     = Left
-  opposite UpLeft    = DownRight
-  opposite UpRight   = DownLeft
-  opposite DownLeft  = UpRight
-  opposite DownRight = UpLeft
-  opposite Here      = Here
-
-move :: Num a => Direction -> Position' a -> Position' a
-move Up        = y -~ 1
-move Down      = y +~ 1
-move Left      = x -~ 1
-move Right     = x +~ 1
-move UpLeft    = move Up . move Left
-move UpRight   = move Up . move Right
-move DownLeft  = move Down . move Left
-move DownRight = move Down . move Right
-move Here      = id
-
-asPosition :: Direction -> Position
-asPosition dir = move dir mempty
-
--- | Returns the direction that a given position is from a given source position
-directionOf
-  :: Position -- ^ Source
-  -> Position -- ^ Target
-  -> Direction
-directionOf (Position x₁ y₁) (Position x₂ y₂) =
-  case (x₁ `compare` x₂, y₁ `compare` y₂) of
-    (EQ, EQ) -> Here
-    (EQ, LT) -> Down
-    (EQ, GT) -> Up
-    (LT, EQ) -> Right
-    (GT, EQ) -> Left
-
-    (LT, LT) -> DownRight
-    (GT, LT) -> DownLeft
-
-    (LT, GT) -> UpRight
-    (GT, GT) -> UpLeft
-
--- | Take one (potentially diagonal) step towards the given position
---
--- ∀ src tgt. isUnit (src `diffPositions` (src `stepTowards tgt`))
-stepTowards
-  :: Position -- ^ Source
-  -> Position -- ^ Target
-  -> Position
-stepTowards (view _Position -> p₁) (view _Position -> p₂)
-  | p₁ == p₂ = _Position # p₁
-  | otherwise =
-    let (_:p:_) = line p₁ p₂
-    in _Position # p
-
--- | Newtype controlling arbitrary generation to only include cardinal
--- directions ('Up', 'Down', 'Left', 'Right')
-newtype Cardinal = Cardinal { getCardinal :: Direction }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, Function, CoArbitrary)
-  deriving newtype (Opposite)
-
-instance Arbitrary Cardinal where
-  arbitrary = Cardinal <$> elements [Up, Down, Left, Right]
-
---------------------------------------------------------------------------------
-
-data Corner
-  = TopLeft
-  | TopRight
-  | BottomLeft
-  | BottomRight
-  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)
-  deriving Arbitrary via GenericArbitrary Corner
-
-instance Opposite Corner where
-  opposite TopLeft = BottomRight
-  opposite TopRight = BottomLeft
-  opposite BottomLeft = TopRight
-  opposite BottomRight = TopLeft
-
-data Edge
-  = TopEdge
-  | LeftEdge
-  | RightEdge
-  | BottomEdge
-  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)
-  deriving Arbitrary via GenericArbitrary Edge
-
-instance Opposite Edge where
-  opposite TopEdge = BottomEdge
-  opposite BottomEdge = TopEdge
-  opposite LeftEdge = RightEdge
-  opposite RightEdge = LeftEdge
-
-cornerEdges :: Corner -> (Edge, Edge)
-cornerEdges TopLeft = (TopEdge, LeftEdge)
-cornerEdges TopRight = (TopEdge, RightEdge)
-cornerEdges BottomLeft = (BottomEdge, LeftEdge)
-cornerEdges BottomRight = (BottomEdge, RightEdge)
-
---------------------------------------------------------------------------------
-
-data Neighbors a = Neighbors
-  { _topLeft
-  , _top
-  , _topRight
-  , _left
-  , _right
-  , _bottomLeft
-  , _bottom
-  , _bottomRight :: a
-  }
-  deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, MonoFoldable)
-
-deriving via (GenericArbitrary (Neighbors a)) instance (Arbitrary a) => Arbitrary (Neighbors a)
-
-type instance Element (Neighbors a) = a
-
-makeFieldsNoPrefix ''Neighbors
-
-instance Applicative Neighbors where
-  pure α = Neighbors
-    { _topLeft     = α
-    , _top         = α
-    , _topRight    = α
-    , _left        = α
-    , _right       = α
-    , _bottomLeft  = α
-    , _bottom      = α
-    , _bottomRight = α
-    }
-  nf <*> nx = Neighbors
-    { _topLeft     = nf ^. topLeft     $ nx ^. topLeft
-    , _top         = nf ^. top         $ nx ^. top
-    , _topRight    = nf ^. topRight    $ nx ^. topRight
-    , _left        = nf ^. left        $ nx ^. left
-    , _right       = nf ^. right       $ nx ^. right
-    , _bottomLeft  = nf ^. bottomLeft  $ nx ^. bottomLeft
-    , _bottom      = nf ^. bottom      $ nx ^. bottom
-    , _bottomRight = nf ^. bottomRight $ nx ^. bottomRight
-    }
-
-edges :: Neighbors a -> Edges a
-edges neighs = Edges
-  { eTop = neighs ^. top
-  , eBottom = neighs ^. bottom
-  , eLeft = neighs ^. left
-  , eRight = neighs ^. right
-  }
-
-neighborDirections :: Neighbors Direction
-neighborDirections = Neighbors
-  { _topLeft     = UpLeft
-  , _top         = Up
-  , _topRight    = UpRight
-  , _left        = Left
-  , _right       = Right
-  , _bottomLeft  = DownLeft
-  , _bottom      = Down
-  , _bottomRight = DownRight
-  }
-
-neighborPositions :: Num a => Position' a -> Neighbors (Position' a)
-neighborPositions pos = (`move` pos) <$> neighborDirections
-
-neighborCells :: Num a => V2 a -> Neighbors (V2 a)
-neighborCells = map (view _Position) . neighborPositions . review _Position
-
-arrayNeighbors
-  :: (IArray a e, Ix i, Num i)
-  => a (V2 i) e
-  -> V2 i
-  -> Neighbors (Maybe e)
-arrayNeighbors arr center = arrLookup <$> neighborPositions (_Position # center)
-  where
-    arrLookup (view _Position -> pos)
-      | inRange (bounds arr) pos = Just $ arr ! pos
-      | otherwise                = Nothing
-
--- | Returns a list of all 4 90-degree rotations of the given neighbors
-rotations :: Neighbors a -> V4 (Neighbors a)
-rotations orig@(Neighbors tl t tr l r bl b br) = V4
-   orig                            -- tl t  tr
-                                   -- l     r
-                                   -- bl b  br
-
-   (Neighbors bl l tl b t br r tr) -- bl l tl
-                                   -- b    t
-                                   -- br r tr
-
-   (Neighbors br b bl r l tr t tl) -- br b bl
-                                   -- r    l
-                                   -- tr t tl
-
-   (Neighbors tr r br t b tl l bl) -- tr r br
-                                   -- t    b
-                                   -- tl l bl
-
---------------------------------------------------------------------------------
-
-newtype Per a b = Rate Double
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON)
-       via Double
-  deriving (Semigroup, Monoid) via Product Double
-  deriving Show via ShowUnitSuffix (Per a b) Double
-deriving via Double
-  instance ( Distribution d Double
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d (Per a b)
-
-instance (Unit a, Unit b) => Unit (a `Per` b) where
-  unitSuffix = unitSuffix @a <> "/" <> unitSuffix @b
-
-invertRate :: a `Per` b -> b `Per` a
-invertRate (Rate p) = Rate $ 1 / p
-
-invertedRate :: Iso (a `Per` b) (b' `Per` a') (b `Per` a) (a' `Per` b')
-invertedRate = iso invertRate invertRate
-
-type (:+:) :: Type -> Type -> Type
-type family (:+:) a b where
-  a :+: a       = a
-  a :+: (Uno b) = a
-
-infixl 6 |+|
-class AddUnit a b where
-  (|+|) :: a -> b -> a :+: b
-
-instance Scalar a => AddUnit a a where
-  x' |+| y' = fromScalar $ scalar x' + scalar y'
-
-instance (Scalar a, Scalar b) => AddUnit a (Uno b) where
-  x' |+| y' = fromScalar $ scalar x' + scalar y'
-
-type (:*:) :: Type -> Type -> Type
-type family (:*:) a b where
-  (a `Per` b) :*: b     = a
-  (Square a)  :*: a     = Cubic a
-  a           :*: a     = Square a
-  a           :*: Uno b = a
-  a           :*: b     = a :**: b
-
-infixl 7 |*|
-class MulUnit a b where
-  (|*|) :: a -> b -> a :*: b
-
-instance (Scalar a, Scalar b) => MulUnit (a `Per` b) b where
-  (Rate rate) |*| b = fromScalar $ rate * scalar b
-
-instance forall a. (Scalar a, a :*: a ~ Square a) => MulUnit a a where
-  x' |*| y' = Square @a . fromScalar $ scalar x' * scalar y'
-
-instance forall a. (Scalar a) => MulUnit (Square a) a where
-  x' |*| y' = Cubic @a . fromScalar $ scalar x' * scalar y'
-
-instance {-# INCOHERENT #-} forall a b.
-  (Scalar a, Scalar b, Scalar (a :*: Uno b))
-    => MulUnit a (Uno b) where
-  x' |*| y' = fromScalar $ scalar x' * scalar y'
-
-type (:/:) :: Type -> Type -> Type
-type family (:/:) a b where
-  (Square a) :/: a          = a
-  (Cubic a)  :/: a          = Square a
-  (Cubic a)  :/: (Square a) = a
-  (a :**: b) :/: b          = a
-  (a :**: b) :/: a          = b
-  a          :/: Uno b      = a
-  a          :/: b          = a `Per` b
-
-infixl 7 |/|
-class DivUnit a b where
-  (|/|) :: a -> b -> a :/: b
-
-instance Scalar a => DivUnit (Square a) a where
-  (Square a) |/| b = fromScalar $ scalar a / scalar b
-
-instance Scalar a => DivUnit (Cubic a) a where
-  (Cubic a) |/| b = fromScalar $ scalar a / scalar b
-
-instance (Scalar a, Cubic a :/: Square a ~ a)
-       => DivUnit (Cubic a) (Square a) where
-  (Cubic a) |/| (Square b) = fromScalar $ scalar a / scalar b
-
-instance (Scalar a, Scalar b) => DivUnit (a :**: b) b where
-  (Times a) |/| b = fromScalar $ scalar a / scalar b
-
-instance (Scalar a, Scalar b) => DivUnit (a :**: b) a where
-  (Times a) |/| b = fromScalar $ scalar a / scalar b
-
-instance {-# INCOHERENT #-} forall a b.
-  (Scalar a, Scalar b, Scalar (a :/: Uno b))
-    => DivUnit a (Uno b) where
-  x' |/| y' = fromScalar $ scalar x' / scalar y'
-
--- | Dimensionless quantitites (mass per unit mass, radians, etc)
---
--- see <https://en.wikipedia.org/wiki/Parts-per_notation#Uno>
-newtype Uno a = Uno a
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON
-           , Scalar, Show
-           )
-       via a
-  deriving Unit via UnitSymbol "" (Uno a)
-
-newtype Square a = Square a
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON
-           , Scalar
-           )
-       via a
-deriving via (a :: Type)
-  instance ( Distribution d a
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d (Square a)
-
-instance Unit a => Unit (Square a) where
-  unitSuffix = unitSuffix @a <> "²"
-
-instance Show a => Show (Square a) where
-  show (Square n) = show n <> "²"
-
-squared :: (Scalar a, a :*: a ~ Square a) => a -> Square a
-squared v = v |*| v
-
-newtype Cubic a = Cubic a
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving ( Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON
-           , Scalar
-           )
-       via a
-deriving via (a :: Type)
-  instance ( Distribution d a
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d (Cubic a)
-
-instance Unit a => Unit (Cubic a) where
-  unitSuffix = unitSuffix @a <> "³"
-
-instance Show a => Show (Cubic a) where
-  show (Cubic n) = show n <> "³"
-
-newtype (:**:) a b = Times Double
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Arbitrary, Num, Ord, Enum, Real, Fractional, ToJSON, FromJSON)
-       via Double
-  deriving (Semigroup, Monoid) via Sum Double
-  deriving Show via ShowUnitSuffix (a :**: b) Double
-deriving via Double
-  instance ( Distribution d Double
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d (a :**: b)
-
-instance (Unit a, Unit b) => Unit (a :**: b) where
-  unitSuffix = unitSuffix @a <> " " <> unitSuffix @b
-
---------------------------------------------------------------------------------
-
-newtype Ticks = Ticks Word
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Num, Ord, Bounded, Enum, Integral, Real, ToJSON, FromJSON) via Word
-  deriving (Semigroup, Monoid) via (Sum Word)
-  deriving Scalar via ScalarIntegral Ticks
-  deriving Arbitrary via GenericArbitrary Ticks
-  deriving Unit via UnitSymbol "ticks" Ticks
-  deriving Show via ShowUnitSuffix Ticks Word
-deriving via Word
-  instance ( Distribution d Word
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d Ticks
-
-newtype Tiles = Tiles Double
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Num, Ord, Enum, Real, ToJSON, FromJSON, Scalar) via Double
-  deriving (Semigroup, Monoid) via (Sum Double)
-  deriving Arbitrary via GenericArbitrary Tiles
-  deriving Unit via UnitSymbol "m" Tiles
-  deriving Show via ShowUnitSuffix Tiles Double
-deriving via Double
-  instance ( Distribution d Double
-           , forall xx yy. Coercible xx yy => Coercible (d xx) (d yy)
-           )
-  => Distribution d Tiles
-
-type TicksPerTile = Ticks `Per` Tiles
-type TilesPerTick = Tiles `Per` Ticks
-
-timesTiles :: TicksPerTile -> Tiles -> Ticks
-timesTiles = (|*|)
-
--- | Calculate the (cartesian) distance between two 'Position's, floored and
--- represented as a number of 'Tile's
---
--- Note that this is imprecise, and may be different than the length of a
--- bresenham's line between the points
-distance :: Position -> Position -> Tiles
-distance
-  = (fromScalar .) . (Metric.distance `on` (fmap fromIntegral . view _Position))
-
---------------------------------------------------------------------------------
-
-newtype Hitpoints = Hitpoints Word
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving ( Arbitrary, Num, Ord, Bounded, Enum, Integral, Real, Scalar
-           , ToJSON, FromJSON
-           )
-       via Word
-  deriving (Semigroup, Monoid) via Sum Word
-  deriving Unit via UnitSymbol "hp" Hitpoints
-  deriving Show via ShowUnitSuffix Hitpoints Word
-
---------------------------------------------------------------------------------
-
--- | Grams, the fundamental measure of weight in Xanthous.
-newtype Grams = Grams Double
-  deriving stock (Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving ( Arbitrary, Num, Ord, Enum, Real, Floating, Fractional, RealFloat
-           , RealFrac, Scalar, ToJSON, FromJSON
-           )
-       via Double
-  deriving (Semigroup, Monoid) via Sum Double
-  deriving Unit via UnitSymbol "g" Grams
-  deriving Show via ShowUnitSuffix Grams Double
-
--- | Every tile is 1 meter
-type Meters = Tiles
-
---------------------------------------------------------------------------------
-
-data Box a = Box
-  { _topLeftCorner :: V2 a
-  , _dimensions    :: V2 a
-  }
-  deriving stock (Show, Eq, Ord, Functor, Generic)
-makeFieldsNoPrefix ''Box
-
--- It seems to be necessary to have an `Arg (V2 a) a` constraint, as a is passed
--- to V2 internally, in order to make GHC figure out this deriving via correctly.
-deriving via (GenericArbitrary (Box a)) instance (Arbitrary a) => Arbitrary (Box a)
-
-bottomRightCorner :: Num a => Box a -> V2 a
-bottomRightCorner box =
-  V2 (box ^. topLeftCorner . L._x + box ^. dimensions . L._x)
-     (box ^. topLeftCorner . L._y + box ^. dimensions . L._y)
-
-setBottomRightCorner :: (Num a, Ord a) => Box a -> V2 a -> Box a
-setBottomRightCorner box br@(V2 brx bry)
-  | brx < box ^. topLeftCorner . L._x || bry < box ^. topLeftCorner . L._y
-  = box & topLeftCorner .~ br
-        & dimensions . L._x .~ ((box ^. topLeftCorner . L._x) - brx)
-        & dimensions . L._y .~ ((box ^. topLeftCorner . L._y) - bry)
-  | otherwise
-  = box & dimensions . L._x .~ (brx - (box ^. topLeftCorner . L._x))
-        & dimensions . L._y .~ (bry - (box ^. topLeftCorner . L._y))
-
-inBox :: (Ord a, Num a) => Box a -> V2 a -> Bool
-inBox box pt = flip all [L._x, L._y] $ \component ->
-  between (box ^. topLeftCorner . component)
-          (box ^. to bottomRightCorner . component)
-          (pt ^. component)
-
-boxIntersects :: (Ord a, Num a) => Box a -> Box a -> Bool
-boxIntersects box₁ box₂
-  = any (inBox box₁) [box₂ ^. topLeftCorner, bottomRightCorner box₂]
-
-boxCenter :: (Fractional a) => Box a -> V2 a
-boxCenter box = V2 cx cy
- where
-   cx = box ^. topLeftCorner . L._x + (box ^. dimensions . L._x / 2)
-   cy = box ^. topLeftCorner . L._y + (box ^. dimensions . L._y / 2)
-
-boxEdge :: (Enum a, Num a) => Box a -> Edge -> [V2 a]
-boxEdge box LeftEdge =
-  V2 (box ^. topLeftCorner . L._x)
-  <$> [box ^. topLeftCorner . L._y .. box ^. to bottomRightCorner . L._y]
-boxEdge box RightEdge =
-  V2 (box ^. to bottomRightCorner . L._x)
-  <$> [box ^. to bottomRightCorner . L._y .. box ^. to bottomRightCorner . L._y]
-boxEdge box TopEdge =
-  flip V2 (box ^. topLeftCorner . L._y)
-  <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x]
-boxEdge box BottomEdge =
-  flip V2 (box ^. to bottomRightCorner . L._y)
-  <$> [box ^. topLeftCorner . L._x .. box ^. to bottomRightCorner . L._x]
diff --git a/users/grfn/xanthous/src/Xanthous/Data/App.hs b/users/grfn/xanthous/src/Xanthous/Data/App.hs
deleted file mode 100644
index 13c4b5d61068..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/App.hs
+++ /dev/null
@@ -1,47 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Data.App
-  ( Panel(..)
-  , ResourceName(..)
-  , AppEvent(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Test.QuickCheck
-import Test.QuickCheck.Instances.Text ()
-import Data.Aeson (ToJSON, FromJSON)
---------------------------------------------------------------------------------
-import Xanthous.Util.QuickCheck
---------------------------------------------------------------------------------
-
--- | Enum for "panels" displayed in the game's UI.
-data Panel
-  = -- | A panel providing help with the game's commands
-    HelpPanel
-  | -- | A panel displaying the character's inventory
-    InventoryPanel
-  | -- | A panel describing an item in the inventory in detail
-    --
-    -- The argument is the full description of the item
-    ItemDescriptionPanel Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary Panel
-
-
-data ResourceName
-  = MapViewport -- ^ The main viewport where we display the game content
-  | Character   -- ^ The character
-  | MessageBox  -- ^ The box where we display messages to the user
-  | Prompt      -- ^ The game's prompt
-  | Panel Panel -- ^ A panel in the game
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary ResourceName
-
-data AppEvent
-  = AutoContinue -- ^ Continue whatever autocommand has been requested by the
-                 --   user
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary AppEvent
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Entities.hs b/users/grfn/xanthous/src/Xanthous/Data/Entities.hs
deleted file mode 100644
index 39953410f2f3..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Entities.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.Entities
-  ( -- * Collisions
-    Collision(..)
-  , _Stop
-  , _Combat
-    -- * Entity Attributes
-  , EntityAttributes(..)
-  , blocksVision
-  , blocksObject
-  , collision
-  , defaultEntityAttributes
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson (ToJSON(..), FromJSON(..), (.:?), (.!=), withObject)
-import           Data.Aeson.Generic.DerivingVia
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
-import           Test.QuickCheck
---------------------------------------------------------------------------------
-
-data Collision
-  = Stop   -- ^ Can't move through this
-  | Combat -- ^ Moving into this equates to hitting it with a stick
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Collision
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ AllNullaryToStringTag 'True ]
-           Collision
-makePrisms ''Collision
-
--- | Attributes of an entity
-data EntityAttributes = EntityAttributes
-  { _blocksVision :: Bool
-    -- | Does this entity block a large object from being put in the same tile as
-    -- it - eg a a door being closed on it
-  , _blocksObject :: Bool
-    -- | What type of collision happens when moving into this entity?
-  , _collision :: Collision
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary EntityAttributes
-  deriving (ToJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           EntityAttributes
-makeLenses ''EntityAttributes
-
-instance FromJSON EntityAttributes where
-  parseJSON = withObject "EntityAttributes" $ \o -> do
-    _blocksVision <- o .:? "blocksVision"
-                      .!= _blocksVision defaultEntityAttributes
-    _blocksObject <- o .:? "blocksObject"
-                      .!= _blocksObject defaultEntityAttributes
-    _collision    <- o .:? "collision"
-                      .!= _collision defaultEntityAttributes
-    pure EntityAttributes {..}
-
-defaultEntityAttributes :: EntityAttributes
-defaultEntityAttributes = EntityAttributes
-  { _blocksVision = False
-  , _blocksObject = False
-  , _collision    = Stop
-  }
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs
deleted file mode 100644
index 855a3462daee..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# LANGUAGE RoleAnnotations      #-}
-{-# LANGUAGE RecordWildCards      #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE AllowAmbiguousTypes  #-}
-{-# LANGUAGE TemplateHaskell      #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityChar
-  ( EntityChar(..)
-  , HasChar(..)
-  , HasStyle(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((.=))
---------------------------------------------------------------------------------
-import qualified Graphics.Vty.Attributes as Vty
-import           Test.QuickCheck
-import           Data.Aeson
---------------------------------------------------------------------------------
-import           Xanthous.Orphans ()
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
---------------------------------------------------------------------------------
-
-
-class HasChar s a | s -> a where
-  char :: Lens' s a
-  {-# MINIMAL char #-}
-
-data EntityChar = EntityChar
-  { _char :: Char
-  , _style :: Vty.Attr
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary EntityChar
-makeFieldsNoPrefix ''EntityChar
-
-instance FromJSON EntityChar where
-  parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr
-  parseJSON (Object o) = do
-    (EntityChar _char _) <- o .: "char"
-    _style <- o .:? "style" .!= Vty.defAttr
-    pure EntityChar {..}
-  parseJSON _ = fail "Invalid type, expected string or object"
-
-instance ToJSON EntityChar where
-  toJSON (EntityChar chr styl)
-    | styl == Vty.defAttr = String $ chr <| Empty
-    | otherwise = object
-      [ "char" .= chr
-      , "style" .= styl
-      ]
-
-instance IsString EntityChar where
-  fromString [ch] = EntityChar ch Vty.defAttr
-  fromString _ = error "Entity char must only be a single character"
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
deleted file mode 100644
index 33a98f1ae5a9..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
+++ /dev/null
@@ -1,276 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveTraversable  #-}
-{-# LANGUAGE TupleSections      #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveFunctor      #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityMap
-  ( EntityMap
-  , _EntityMap
-  , EntityID
-  , emptyEntityMap
-  , insertAt
-  , insertAtReturningID
-  , fromEIDsAndPositioned
-  , toEIDsAndPositioned
-  , atPosition
-  , atPositionWithIDs
-  , positions
-  , lookup
-  , lookupWithPosition
-  , positionOf
-  -- , positionedEntities
-  , neighbors
-  , Deduplicate(..)
-
-  -- * debug
-  , byID
-  , byPosition
-  , lastID
-
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (lookup)
-import Xanthous.Data
-  ( Position
-  , Positioned(..)
-  , positioned
-  , Neighbors(..)
-  , neighborPositions, position
-  )
-import Xanthous.Data.VectorBag
-import Xanthous.Orphans ()
-import Xanthous.Util (EqEqProp(..))
---------------------------------------------------------------------------------
-import Data.Monoid (Endo(..))
-import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function)
-import Test.QuickCheck.Checkers (EqProp)
-import Test.QuickCheck.Instances.UnorderedContainers ()
-import Test.QuickCheck.Instances.Vector ()
-import Text.Show (showString, showParen)
-import Data.Aeson
---------------------------------------------------------------------------------
-
-type EntityID = Word32
-type NonNullSet a = NonNull (Set a)
-
-data EntityMap a where
-  EntityMap ::
-    { _byPosition :: Map Position (NonNullSet EntityID)
-    , _byID       :: HashMap EntityID (Positioned a)
-    , _lastID     :: EntityID
-    } -> EntityMap a
-  deriving stock (Functor, Foldable, Traversable, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-deriving via (EqEqProp (EntityMap a)) instance (Eq a, Ord a) => EqProp (EntityMap a)
-makeLenses ''EntityMap
-
-instance ToJSON a => ToJSON (EntityMap a) where
-  toJSON = toJSON . toEIDsAndPositioned
-
-
-instance FromJSON a => FromJSON (EntityMap a) where
-  parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON
-
-byIDInvariantError :: forall a. a
-byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition "
-  <> "must point to entityIDs in byID"
-
-instance (Ord a, Eq a) => Eq (EntityMap a) where
-  -- em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap
-  (==) = (==) `on` view (_EntityMap . to sort)
-
-deriving stock instance (Ord a) => Ord (EntityMap a)
-
-instance Show a => Show (EntityMap a) where
-  showsPrec pr em
-    = showParen (pr > 10)
-    $ showString
-    . ("fromEIDsAndPositioned " <>)
-    . show
-    . toEIDsAndPositioned
-    $ em
-
-instance Arbitrary a => Arbitrary (EntityMap a) where
-  arbitrary = review _EntityMap <$> arbitrary
-  shrink em = review _EntityMap <$> shrink (em ^. _EntityMap)
-
-type instance Index (EntityMap a) = EntityID
-type instance IxValue (EntityMap a) = (Positioned a)
-instance Ixed (EntityMap a) where ix eid = at eid . traverse
-
-instance At (EntityMap a) where
-  at eid = lens (view $ byID . at eid) setter
-    where
-      setter :: EntityMap a -> Maybe (Positioned a) -> EntityMap a
-      setter m Nothing = fromMaybe m $ do
-        Positioned pos _ <- m ^. byID . at eid
-        pure $ m
-          & removeEIDAtPos pos
-          & byID . at eid .~ Nothing
-      setter m (Just pe@(Positioned pos _)) = m
-        & (case lookupWithPosition eid m of
-             Nothing -> id
-             Just (Positioned origPos _) -> removeEIDAtPos origPos
-          )
-        & byID . at eid ?~ pe
-        & byPosition . at pos %~ \case
-            Nothing -> Just $ opoint eid
-            Just es -> Just $ ninsertSet eid es
-      removeEIDAtPos pos =
-        byPosition . at pos %~ (>>= fromNullable . ndeleteSet eid)
-
-instance Semigroup (EntityMap a) where
-  em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁
-
-instance Monoid (EntityMap a) where
-  mempty = emptyEntityMap
-
-instance FunctorWithIndex EntityID EntityMap
-
-instance FoldableWithIndex EntityID EntityMap
-
-instance TraversableWithIndex EntityID EntityMap where
-  itraverse = itraverseOf itraversed
-
-type instance Element (EntityMap a) = a
-instance MonoFoldable (EntityMap a)
-
-emptyEntityMap :: EntityMap a
-emptyEntityMap = EntityMap mempty mempty 0
-
-newtype Deduplicate a = Deduplicate (EntityMap a)
-  deriving stock (Show, Traversable, Generic)
-  deriving newtype (Eq, Functor, Foldable, EqProp, Arbitrary)
-
-instance Semigroup (Deduplicate a) where
-  (Deduplicate em₁) <> (Deduplicate em₂) =
-    let _byID = em₁ ^. byID <> em₂ ^. byID
-        _byPosition = mempty &~ do
-          ifor_ _byID $ \eid (Positioned pos _) ->
-            at pos %= \case
-              Just eids -> Just $ ninsertSet eid eids
-              Nothing -> Just $ opoint eid
-        _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID
-    in Deduplicate EntityMap{..}
-
-
---------------------------------------------------------------------------------
-
-_EntityMap :: Iso' (EntityMap a) [(Position, a)]
-_EntityMap = iso hither yon
-  where
-    hither :: EntityMap a -> [(Position, a)]
-    hither em = do
-       (pos, eids) <- em ^. byPosition . _Wrapped
-       eid <- toList eids
-       ent <- em ^.. byID . at eid . folded . positioned
-       pure (pos, ent)
-    yon :: [(Position, a)] -> EntityMap a
-    yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap
-
-
-insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a)
-insertAtReturningID pos e em =
-  let (eid, em') = em & lastID <+~ 1
-  in em'
-     & byID . at eid ?~ Positioned pos e
-     & byPosition . at pos %~ \case
-       Nothing -> Just $ opoint eid
-       Just es -> Just $ ninsertSet eid es
-     & (eid, )
-
-insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a
-insertAt pos e = snd . insertAtReturningID pos e
-
-atPosition :: forall a. (Ord a, Show a) => Position -> Lens' (EntityMap a) (VectorBag a)
-atPosition pos = lens getter setter
-  where
-    getter em =
-      let eids :: VectorBag EntityID
-          eids = maybe mempty (VectorBag . toVector . toNullable)
-                 $ em ^. byPosition . at pos
-      in getEIDAssume em <$> eids
-    setter em Empty = em & byPosition . at pos .~ Nothing
-    setter em (sort -> entities) =
-      let origEIDs = maybe Empty toNullable $ em ^. byPosition . at pos
-          origEntitiesWithIDs =
-            sortOn snd $ toList origEIDs <&> \eid -> (eid, getEIDAssume em eid)
-          go alles₁@((eid, e₁) :< es₁) -- orig
-             (e₂ :< es₂)               -- new
-            | e₁ == e₂
-              -- same, do nothing
-            = let (eids, lastEID, byID') = go es₁ es₂
-              in (insertSet eid eids, lastEID, byID')
-            | otherwise
-              -- e₂ is new, generate a new ID for it
-            = let (eids, lastEID, byID') = go alles₁ es₂
-                  eid' = succ lastEID
-              in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos e₂)
-          go Empty Empty = (mempty, em ^. lastID, em ^. byID)
-          go orig Empty =
-            let byID' = foldr deleteMap (em ^. byID) $ map fst orig
-            in (mempty, em ^. lastID, byID')
-          go Empty (new :< news) =
-            let (eids, lastEID, byID') = go Empty news
-                eid' = succ lastEID
-            in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos new)
-          go _ _ = error "unreachable"
-          (eidsAtPosition, newLastID, newByID) = go origEntitiesWithIDs entities
-      in em & byPosition . at pos .~ fromNullable eidsAtPosition
-            & byID .~ newByID
-            & lastID .~ newLastID
-
-getEIDAssume :: EntityMap a -> EntityID -> a
-getEIDAssume em eid = fromMaybe byIDInvariantError
-  $ em ^? byID . ix eid . positioned
-
-atPositionWithIDs :: Position -> EntityMap a -> Vector (EntityID, Positioned a)
-atPositionWithIDs pos em =
-  let eids = maybe mempty (toVector . toNullable)
-             $ em ^. byPosition . at pos
-  in (id &&& Positioned pos . getEIDAssume em) <$> eids
-
-fromEIDsAndPositioned
-  :: forall mono a. (MonoFoldable mono, Element mono ~ (EntityID, Positioned a))
-  => mono
-  -> EntityMap a
-fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty
-  where
-    insert' (eid, pe@(Positioned pos _))
-      = (byID . at eid ?~ pe)
-      . (byPosition . at pos %~ \case
-            Just eids -> Just $ ninsertSet eid eids
-            Nothing   -> Just $ opoint eid
-        )
-    newLastID em = em & lastID
-      .~ fromMaybe 1
-         (maximumOf (ifolded . asIndex) (em ^. byID))
-
-toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)]
-toEIDsAndPositioned = itoListOf $ byID . ifolded
-
-positions :: EntityMap a -> [Position]
-positions = toListOf $ byPosition . to keys . folded
-
-lookupWithPosition :: EntityID -> EntityMap a -> Maybe (Positioned a)
-lookupWithPosition eid = view $ byID . at eid
-
-lookup :: EntityID -> EntityMap a -> Maybe a
-lookup eid = fmap (view positioned) . lookupWithPosition eid
-
--- unlawful :(
--- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b)
--- positionedEntities = byID . itraversed
-
-neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a)
-neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos
-
--- | Traversal to the position of the entity with the given ID
-positionOf :: EntityID -> Traversal' (EntityMap a) Position
-positionOf eid = ix eid . position
-
---------------------------------------------------------------------------------
-makeWrapped ''Deduplicate
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
deleted file mode 100644
index 1398c611cf20..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
+++ /dev/null
@@ -1,72 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityMap.Graphics
-  ( visiblePositions
-  , visibleEntities
-  , lineOfSight
-  , linesOfSight
-  , canSee
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (lines)
---------------------------------------------------------------------------------
-import Xanthous.Util (takeWhileInclusive)
-import Xanthous.Data
-import Xanthous.Data.Entities
-import Xanthous.Data.EntityMap
-import Xanthous.Game.State
-import Xanthous.Util.Graphics (circle, line)
---------------------------------------------------------------------------------
-
--- | Returns a set of positions that are visible, when taking into account
--- 'blocksVision', from the given position, within the given radius.
-visiblePositions
-  :: Entity e
-  => Position
-  -> Word -- ^ Vision radius
-  -> EntityMap e
-  -> Set Position
-visiblePositions pos radius
-  = setFromList . positions . visibleEntities pos radius
-
--- | Returns a list of entities on the *line of sight* from the first position
--- to the second position
-lineOfSight
-  :: forall e. Entity e
-  => Position -- ^ Origin
-  -> Position -- ^ Destination
-  -> EntityMap e
-  -> [(Position, Vector (EntityID, e))]
-lineOfSight (view _Position -> origin) (view _Position -> destination) em =
-  takeWhileInclusive (none (view blocksVision . entityAttributes . snd) . snd)
-    $ getPositionedAt <$> line origin destination
-  where
-    getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
-    getPositionedAt (review _Position -> p) =
-      (p, over _2 (view positioned) <$> atPositionWithIDs p em)
-
--- | Returns a list of individual lines of sight, each of which is a list of
--- entities at positions on that line of sight
-linesOfSight
-  :: forall e. Entity e
-  => Position    -- ^ Centerpoint
-  -> Word        -- ^ Radius
-  -> EntityMap e
-  -> [[(Position, Vector (EntityID, e))]]
-linesOfSight pos visionRadius em =
-  radius <&> \edge -> lineOfSight pos (_Position # edge) em
-  where
-    radius = circle (pos ^. _Position) $ fromIntegral visionRadius
-
--- | Given a point and a radius of vision, returns a list of all entities that
--- are *visible* (eg, not blocked by an entity that obscures vision) from that
--- point
-visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e
-visibleEntities pos visionRadius
-  = fromEIDsAndPositioned
-  . foldMap (\(p, es) -> over _2 (Positioned p) <$> es)
-  . fold
-  . linesOfSight pos visionRadius
-
-canSee :: Entity e => (e -> Bool) -> Position -> Word -> EntityMap e -> Bool
-canSee match pos radius = any match . visibleEntities pos radius
--- ^ this might be optimizable
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
deleted file mode 100644
index 13251d8afdf2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
+++ /dev/null
@@ -1,180 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.Levels
-  ( Levels
-  , allLevels
-  , numLevels
-  , nextLevel
-  , prevLevel
-  , mkLevels1
-  , mkLevels
-  , oneLevel
-  , current
-  , ComonadStore(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((<.>), Empty, foldMap)
-import           Xanthous.Util (between, EqProp, EqEqProp(..))
-import           Xanthous.Util.Comonad (current)
-import           Xanthous.Orphans ()
---------------------------------------------------------------------------------
-import           Control.Comonad.Store
-import           Control.Comonad.Store.Zipper
-import           Data.Aeson (ToJSON(..), FromJSON(..))
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Functor.Apply
-import           Data.Foldable (foldMap)
-import           Data.List.NonEmpty (NonEmpty)
-import qualified Data.List.NonEmpty as NE
-import           Data.Maybe (fromJust)
-import           Data.Sequence (Seq((:<|), Empty))
-import           Data.Semigroup.Foldable.Class
-import           Data.Text (replace)
-import           Test.QuickCheck
---------------------------------------------------------------------------------
-
--- | Collection of levels plus a pointer to the current level
---
--- Navigation is via the 'Comonad' instance. We can get the current level with
--- 'extract':
---
---     extract @Levels :: Levels level -> level
---
--- For access to and modification of the level, use
--- 'Xanthous.Util.Comonad.current'
-newtype Levels a = Levels { levelZipper :: Zipper Seq a }
-    deriving stock (Generic)
-    deriving (Functor, Comonad, Foldable) via (Zipper Seq)
-
-type instance Element (Levels a) = a
-instance MonoFoldable (Levels a)
-instance MonoFunctor (Levels a)
-instance MonoTraversable (Levels a)
-
-instance ComonadStore Word Levels where
-  pos = toEnum . pos . levelZipper
-  peek i = peek (fromEnum i) . levelZipper
-
-instance Traversable Levels where
-  traverse f (Levels z) = Levels <$> traverse f z
-
-instance Foldable1 Levels
-
-instance Traversable1 Levels where
-  traverse1 f levs@(Levels z) = seek (pos levs) . partialMkLevels <$> go (unzipper z)
-    where
-      go Empty = error "empty seq, unreachable"
-      go (x :<| xs) = (<|) <$> f x <.> go xs
-
--- | Always takes the position of the latter element
-instance Semigroup (Levels a) where
-  levs₁ <> levs₂
-    = seek (pos levs₂)
-    . partialMkLevels
-    $ allLevels levs₁ <> allLevels levs₂
-
--- | The number of levels stored in 'Levels'
---
--- Equivalent to 'Data.Foldable.length', but likely faster
-numLevels :: Levels a -> Word
-numLevels = toEnum . size . levelZipper
-
--- | Make Levels from a Seq. Throws an error if the seq is not empty
-partialMkLevels :: Seq a -> Levels a
-partialMkLevels = Levels . fromJust . zipper
-
--- | Make Levels from a possibly-empty structure
-mkLevels :: Foldable1 f => f level -> Maybe (Levels level)
-mkLevels = fmap Levels . zipper . foldMap pure
-
--- | Make Levels from a non-empty structure
-mkLevels1 :: Foldable1 f => f level -> Levels level
-mkLevels1 = fromJust . mkLevels
-
-oneLevel :: a -> Levels a
-oneLevel = mkLevels1 . Identity
-
--- | Get a sequence of all the levels
-allLevels :: Levels a -> Seq a
-allLevels = unzipper . levelZipper
-
--- | Step to the next level, generating a new level if necessary using the given
--- applicative action
-nextLevel
-  :: Applicative m
-  => m level -- ^ Generate a new level, if necessary
-  -> Levels level
-  -> m (Levels level)
-nextLevel genLevel levs
-  | succ (pos levs) < numLevels levs
-  = pure $ seeks succ levs
-  | otherwise
-  = genLevel <&> \level ->
-      seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level
-
--- | Go to the previous level. Returns Nothing if 'pos' is 0
-prevLevel :: Levels level -> Maybe (Levels level)
-prevLevel levs | pos levs == 0 = Nothing
-               | otherwise = Just $ seeks pred levs
-
---------------------------------------------------------------------------------
-
--- | alternate, slower representation of Levels we can Iso into to perform
--- various operations
-data AltLevels a = AltLevels
-  { _levels :: NonEmpty a
-  , _currentLevel :: Word -- ^ invariant: is within the bounds of _levels
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           (AltLevels a)
-makeLenses ''AltLevels
-
-alt :: Iso (Levels a) (Levels b) (AltLevels a) (AltLevels b)
-alt = iso hither yon
-  where
-    hither levs = AltLevels (NE.fromList . toList $ allLevels levs) (pos levs)
-    yon (AltLevels levs curr) = seek curr $ mkLevels1 levs
-
-instance Eq a => Eq (Levels a) where
-  (==) = (==) `on` view alt
-
-deriving via EqEqProp (Levels a) instance Eq a => EqProp (Levels a)
-
-instance Show a => Show (Levels a) where
-  show = unpack . replace "AltLevels" "Levels" . pack . show . view alt
-
-instance NFData a => NFData (Levels a) where
-  rnf = rnf . view alt
-
-instance ToJSON a => ToJSON (Levels a) where
-  toJSON = toJSON . view alt
-
-instance FromJSON a => FromJSON (Levels a) where
-  parseJSON = fmap (review alt) . parseJSON
-
-instance Arbitrary a => Arbitrary (AltLevels a) where
-  arbitrary = do
-    _levels <- arbitrary
-    _currentLevel <- choose (0, pred . toEnum . length $ _levels)
-    pure AltLevels {..}
-  shrink als = do
-    _levels <- shrink $ als ^. levels
-    _currentLevel <- filter (between 0 $ pred . toEnum . length $ _levels)
-                    $ shrink $ als ^. currentLevel
-    pure AltLevels {..}
-
-
-instance Arbitrary a => Arbitrary (Levels a) where
-  arbitrary = review alt <$> arbitrary
-  shrink = fmap (review alt) . shrink . view alt
-
-instance CoArbitrary a => CoArbitrary (Levels a) where
-  coarbitrary = coarbitrary . view alt
-
-instance Function a => Function (Levels a) where
-  function = functionMap (view alt) (review alt)
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs b/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
deleted file mode 100644
index 2b2ee0f96028..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
+++ /dev/null
@@ -1,98 +0,0 @@
---------------------------------------------------------------------------------
--- | Memoized values
---------------------------------------------------------------------------------
-module Xanthous.Data.Memo
-  ( Memoized(UnMemoized)
-  , memoizeWith
-  , getMemoized
-  , runMemoized
-  , fillWith
-  , fillWithM
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Data.Aeson (FromJSON, ToJSON)
-import Test.QuickCheck (Arbitrary (arbitrary), oneof, CoArbitrary, Function)
-import Test.QuickCheck.Checkers (EqProp)
-import Xanthous.Util (EqEqProp(EqEqProp))
-import Control.Monad.State.Class (MonadState)
---------------------------------------------------------------------------------
-
--- | A memoized value, keyed by a key
---
--- If key is different than what is stored here, then val is invalid
-data Memoized key val = Memoized key val | UnMemoized
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (Hashable, FromJSON, ToJSON, NFData, CoArbitrary, Function)
-  deriving EqProp via EqEqProp (Memoized key val)
-
-instance (Arbitrary k, Arbitrary v) => Arbitrary (Memoized k v) where
-  arbitrary = oneof [ pure UnMemoized
-                    , Memoized <$> arbitrary <*> arbitrary
-                    ]
-
--- | Construct a memoized value with the given key
-memoizeWith :: forall key val. key -> val -> Memoized key val
-memoizeWith = Memoized
-{-# INLINE memoizeWith #-}
-
--- | Retrieve a memoized value providing the key. If the value is unmemoized or
--- the keys do not match, returns Nothing.
---
--- >>> getMemoized 1 (memoizeWith @Int @Int 1 2)
--- Just 2
---
--- >>> getMemoized 2 (memoizeWith @Int @Int 1 2)
--- Nothing
---
--- >>> getMemoized 1 (UnMemoized :: Memoized Int Int)
--- Nothing
-getMemoized :: Eq key => key -> Memoized key val -> Maybe val
-getMemoized key (Memoized key' v)
-  | key == key' = Just v
-  | otherwise = Nothing
-getMemoized _ UnMemoized = Nothing
-{-# INLINE getMemoized #-}
-
--- | Get a memoized value using an applicative action to obtain the key
-runMemoized
-  :: (Eq key, Applicative m)
-  => Memoized key val
-  -> m key
-  -> m (Maybe val)
-runMemoized m mk = getMemoized <$> mk <*> pure m
-
--- | In a monadic state containing a 'MemoState', look up the current memoized
--- target of some lens keyed by k, filling it with v if not present and
--- returning either the new or old value
-fillWith
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> v
-  -> m v
-fillWith l k v' = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      l .= memoizeWith k v'
-      pure v'
-
--- | In a monadic state, look up the current memoized target of some lens keyed
--- by k, filling it with the result of some monadic action v if not present and
--- returning either the new or old value
-fillWithM
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> m v
-  -> m v
-fillWithM l k mv = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      v' <- mv
-      l .= memoizeWith k v'
-      pure v'
diff --git a/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs b/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs
deleted file mode 100644
index 1b875d448302..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE StandaloneDeriving    #-}
-{-# LANGUAGE PolyKinds             #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.NestedMap
-  ( NestedMapVal(..)
-  , NestedMap(..)
-  , lookup
-  , lookupVal
-  , insert
-
-    -- *
-  , (:->)
-  , BifunctorFunctor'(..)
-  , BifunctorMonad'(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (lookup, foldMap)
-import qualified Xanthous.Prelude as P
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import           Data.Aeson
-import           Data.Function (fix)
-import           Data.Foldable (Foldable(..))
-import           Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NE
---------------------------------------------------------------------------------
-
--- | Natural transformations on bifunctors
-type (:->) p q = forall a b. p a b -> q a b
-infixr 0 :->
-
-class (forall b. Bifunctor b => Bifunctor (t b)) => BifunctorFunctor' t where
-  bifmap' :: (Bifunctor p, Bifunctor q) => (p :-> q) -> t p :-> t q
-
-class BifunctorFunctor' t => BifunctorMonad' t where
-  bireturn' :: (Bifunctor p) => p :-> t p
-
-  bibind' :: (Bifunctor p, Bifunctor q) => (p :-> t q) -> t p :-> t q
-  bibind' f = bijoin' . bifmap' f
-
-  bijoin' :: (Bifunctor p) => t (t p) :-> t p
-  bijoin' = bibind' id
-
-  {-# MINIMAL bireturn', (bibind' | bijoin') #-}
-
---------------------------------------------------------------------------------
-
-data NestedMapVal m k v = Val v | Nested (NestedMap m k v)
-
-deriving stock instance
-  ( forall k' v'. (Show k', Show v') => Show (m k' v')
-  , Show k
-  , Show v
-  ) => Show (NestedMapVal m k v)
-
-deriving stock instance
-  ( forall k' v'. (Eq k', Eq v') => Eq (m k' v')
-  , Eq k
-  , Eq v
-  ) => Eq (NestedMapVal m k v)
-
-instance
-  forall m k v.
-  ( Arbitrary (m k v)
-  , Arbitrary (m k (NestedMapVal m k v))
-  , Arbitrary k
-  , Arbitrary v
-  , IsMap (m k (NestedMapVal m k v))
-  , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-  , ContainerKey (m k (NestedMapVal m k v)) ~ k
-  ) => Arbitrary (NestedMapVal m k v) where
-  arbitrary = sized . fix $ \gen n ->
-    let nst = fmap (NestedMap . mapFromList)
-            . listOf
-            $ (,) <$> arbitrary @k <*> gen (n `div` 2)
-    in if n == 0
-       then Val <$> arbitrary
-       else oneof [ Val <$> arbitrary
-                  , Nested <$> nst]
-  shrink (Val v) = Val <$> shrink v
-  shrink (Nested mkv) = Nested <$> shrink mkv
-
-instance Functor (m k) => Functor (NestedMapVal m k) where
-  fmap f (Val v) = Val $ f v
-  fmap f (Nested m) = Nested $ fmap f m
-
-instance Bifunctor m => Bifunctor (NestedMapVal m) where
-  bimap _ g (Val v) = Val $ g v
-  bimap f g (Nested m) = Nested $ bimap f g m
-
-instance BifunctorFunctor' NestedMapVal where
-  bifmap' _ (Val v) = Val v
-  bifmap' f (Nested m) = Nested $ bifmap' f m
-
-instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v)))
-       => ToJSON (NestedMapVal m k v) where
-  toJSON (Val v) = toJSON v
-  toJSON (Nested m) = toJSON m
-
-instance Foldable (m k) => Foldable (NestedMapVal m k) where
-  foldMap f (Val v) = f v
-  foldMap f (Nested m) = foldMap f m
-
--- _NestedMapVal
---   :: forall m k v m' k' v'.
---     ( IsMap (m k v), IsMap (m' k' v')
---     , IsMap (m [k] v), IsMap (m' [k'] v')
---     , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k'
---     , ContainerKey (m [k] v) ~ [k], ContainerKey (m' [k'] v') ~ [k']
---     , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v'
---     , MapValue (m [k] v) ~ v, MapValue (m' [k'] v') ~ v'
---     )
---   => Iso (NestedMapVal m k v)
---         (NestedMapVal m' k' v')
---         (m [k] v)
---         (m' [k'] v')
--- _NestedMapVal = iso hither yon
---   where
---     hither :: NestedMapVal m k v -> m [k] v
---     hither (Val v) = singletonMap [] v
---     hither (Nested m) = bimap _ _ $ m ^. _NestedMap
---     yon = _
-
---------------------------------------------------------------------------------
-
-newtype NestedMap m k v = NestedMap (m k (NestedMapVal m k v))
-
-deriving stock instance
-  ( forall k' v'. (Eq k', Eq v') => Eq (m k' v')
-  , Eq k
-  , Eq v
-  ) => Eq (NestedMap m k v)
-
-deriving stock instance
-  ( forall k' v'. (Show k', Show v') => Show (m k' v')
-  , Show k
-  , Show v
-  ) => Show (NestedMap m k v)
-
-instance Arbitrary (m k (NestedMapVal m k v))
-       => Arbitrary (NestedMap m k v) where
-  arbitrary = NestedMap <$> arbitrary
-  shrink (NestedMap m) = NestedMap <$> shrink m
-
-instance Functor (m k) => Functor (NestedMap m k) where
-  fmap f (NestedMap m) = NestedMap $ fmap (fmap f) m
-
-instance Bifunctor m => Bifunctor (NestedMap m) where
-  bimap f g (NestedMap m) = NestedMap $ bimap f (bimap f g) m
-
-instance BifunctorFunctor' NestedMap where
-  bifmap' f (NestedMap m) = NestedMap . f $ bimap id (bifmap' f) m
-
-instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v)))
-       => ToJSON (NestedMap m k v) where
-  toJSON (NestedMap m) = toJSON m
-
-instance Foldable (m k) => Foldable (NestedMap m k) where
-  foldMap f (NestedMap m) = foldMap (foldMap f) m
-
---------------------------------------------------------------------------------
-
-lookup
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> NestedMap m k v
-  -> Maybe (NestedMapVal m k v)
-lookup (p :| []) (NestedMap vs) = P.lookup p vs
-lookup (p :| (p₁ : ps)) (NestedMap vs) = P.lookup p vs >>= \case
-  (Val _) -> Nothing
-  (Nested vs') -> lookup (p₁ :| ps) vs'
-
-lookupVal
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> NestedMap m k v
-  -> Maybe v
-lookupVal ks m
-  | Just (Val v) <- lookup ks m = Just v
-  | otherwise                  = Nothing
-
-insert
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> v
-  -> NestedMap m k v
-  -> NestedMap m k v
-insert (k :| []) v (NestedMap m) = NestedMap $ P.insertMap k (Val v) m
-insert (k₁ :| (k₂ : ks)) v (NestedMap m) = NestedMap $ alterMap upd k₁ m
-  where
-    upd (Just (Nested nm)) = Just . Nested $ insert (k₂ :| ks) v nm
-    upd _ = Just $
-      let (kΩ :| ks') = NE.reverse (k₂ :| ks)
-      in P.foldl'
-         (\m' k -> Nested . NestedMap . singletonMap k $ m')
-         (Nested . NestedMap . singletonMap kΩ $ Val v)
-         ks'
-
--- _NestedMap
---   :: ( IsMap (m k v), IsMap (m' k' v')
---     , IsMap (m (NonEmpty k) v), IsMap (m' (NonEmpty k') v')
---     , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k'
---     , ContainerKey (m (NonEmpty k) v) ~ (NonEmpty k)
---     , ContainerKey (m' (NonEmpty k') v') ~ (NonEmpty k')
---     , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v'
---     , MapValue (m (NonEmpty k) v) ~ v, MapValue (m' (NonEmpty k') v') ~ v'
---     )
---   => Iso (NestedMap m k v)
---         (NestedMap m' k' v')
---         (m (NonEmpty k) v)
---         (m' (NonEmpty k') v')
--- _NestedMap = iso undefined yon
---   where
---     hither (NestedMap m) = undefined . mapToList $ m
---     yon mkv = undefined
diff --git a/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs b/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs
deleted file mode 100644
index 2e6d48062a45..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.VectorBag
-  (VectorBag(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Data.Aeson
-import qualified Data.Vector as V
-import           Test.QuickCheck
-import           Test.QuickCheck.Instances.Vector ()
---------------------------------------------------------------------------------
-
--- | Acts exactly like a Vector, except ignores order when testing for equality
-newtype VectorBag a = VectorBag (Vector a)
-  deriving stock
-    ( Traversable
-    , Generic
-    )
-  deriving newtype
-    ( Show
-    , Read
-    , Foldable
-    , FromJSON
-    , FromJSON1
-    , ToJSON
-    , Reversing
-    , Applicative
-    , Functor
-    , Monad
-    , Monoid
-    , Semigroup
-    , Arbitrary
-    , CoArbitrary
-    , Filterable
-    )
-makeWrapped ''VectorBag
-
-instance Function a => Function (VectorBag a) where
-  function = functionMap (\(VectorBag v) -> v) VectorBag
-
-type instance Element (VectorBag a) = a
-deriving via (Vector a) instance MonoFoldable (VectorBag a)
-deriving via (Vector a) instance GrowingAppend (VectorBag a)
-deriving via (Vector a) instance SemiSequence (VectorBag a)
-deriving via (Vector a) instance MonoPointed (VectorBag a)
-deriving via (Vector a) instance MonoFunctor (VectorBag a)
-
-instance Cons (VectorBag a) (VectorBag b) a b where
-  _Cons = prism (\(x, VectorBag xs) -> VectorBag $ x <| xs) $ \(VectorBag v) ->
-    if V.null v
-    then Left (VectorBag mempty)
-    else Right (V.unsafeHead v, VectorBag $ V.unsafeTail v)
-
-instance AsEmpty (VectorBag a) where
-  _Empty = prism' (const $ VectorBag Empty) $ \case
-    (VectorBag Empty) -> Just ()
-    _ -> Nothing
-
-instance Witherable VectorBag where
-  wither f (VectorBag v) = VectorBag <$> wither f v
-  witherM f (VectorBag v) = VectorBag <$> witherM f v
-  filterA p (VectorBag v) = VectorBag <$> filterA p v
-
-{-
-    TODO:
-    , Ixed
-    , FoldableWithIndex
-    , FunctorWithIndex
-    , TraversableWithIndex
-    , Snoc
-    , Each
--}
-
-instance Ord a => Eq (VectorBag a) where
-  (==) = (==) `on` (view _Wrapped . sort)
-
-instance Ord a => Ord (VectorBag a) where
-  compare = compare  `on` (view _Wrapped . sort)
-
-instance MonoTraversable (VectorBag a) where
-  otraverse f (VectorBag v) = VectorBag <$> otraverse f v
-
-instance IsSequence (VectorBag a) where
-  fromList = VectorBag . fromList
-  break prd (VectorBag v) = bimap VectorBag VectorBag $ break prd v
-  span prd (VectorBag v) = bimap VectorBag VectorBag $ span prd v
-  dropWhile prd (VectorBag v) = VectorBag $ dropWhile prd v
-  takeWhile prd (VectorBag v) = VectorBag $ takeWhile prd v
-  splitAt idx (VectorBag v) = bimap VectorBag VectorBag $ splitAt idx v
-  unsafeSplitAt idx (VectorBag v) =
-    bimap VectorBag VectorBag $ unsafeSplitAt idx v
-  take n (VectorBag v) = VectorBag $ take n v
-  unsafeTake n (VectorBag v) = VectorBag $ unsafeTake n v
-  drop n (VectorBag v) = VectorBag $ drop n v
-  unsafeDrop n (VectorBag v) = VectorBag $ unsafeDrop n v
-  partition p (VectorBag v) = bimap VectorBag VectorBag $ partition p v
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs b/users/grfn/xanthous/src/Xanthous/Entities/Character.hs
deleted file mode 100644
index c8153086f1ac..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Character.hs
+++ /dev/null
@@ -1,241 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Character
-
-  ( -- * Character datatype
-    Character(..)
-  , characterName
-  , HasInventory(..)
-  , characterDamage
-  , characterHitpoints'
-  , characterHitpoints
-  , hitpointRecoveryRate
-  , speed
-  , body
-
-    -- *** Body
-  , Body(..)
-  , initialBody
-  , knuckles
-  , Knuckles(..)
-  , fistDamageChance
-  , damageKnuckles
-  , fistfightingDamage
-
-    -- * Character functions
-  , mkCharacter
-  , pickUpItem
-  , isDead
-  , isFullyHealed
-  , damage
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Brick
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Coerce (coerce)
-import           Test.QuickCheck
-import           Test.QuickCheck.Instances.Vector ()
-import           Test.QuickCheck.Arbitrary.Generic
-import           Test.QuickCheck.Gen (chooseUpTo)
-import           Test.QuickCheck.Checkers (EqProp)
-import           Control.Monad.State.Lazy (execState)
-import           Control.Monad.Trans.State.Lazy (execStateT)
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.Common
-import           Xanthous.Data
-                 ( TicksPerTile, Hitpoints, Per, Ticks, (|*|), positioned )
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Util (EqEqProp(EqEqProp), modifyKL)
-import           Xanthous.Monad (say_)
---------------------------------------------------------------------------------
-
--- | The status of the character's knuckles
---
--- This struct is used to track the damage and then eventual build-up of
--- calluses when the character is fighting with their fists
-data Knuckles = Knuckles
-  { -- | How damaged are the knuckles currently, from 0 to 5?
-    --
-    -- At 0, no calluses will form
-    -- At 1 and up, the character will form calluses after a while
-    -- At 5, continuing to fistfight will deal the character even more damage
-    _knuckleDamage   :: !Word
-    -- | How built-up are the character's calluses, from 0 to 5?
-    --
-    -- Each level of calluses decreases the likelihood of being damaged when
-    -- fistfighting by 1%, up to 5 where the character will never be damaged
-    -- fistfighting
-  , _knuckleCalluses :: !Word
-
-    -- | Number of turns that have passed since the last time the knuckles were
-    -- damaged
-  , _ticksSinceDamaged :: Ticks
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving EqProp via EqEqProp Knuckles
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Knuckles
-makeLenses ''Knuckles
-
-instance Semigroup Knuckles where
-  (Knuckles d₁ c₁ t₁) <> (Knuckles d₂ c₂ t₂) = Knuckles
-    (min (d₁ + d₂) 5)
-    (min (c₁ + c₂) 5)
-    (max t₁ t₂)
-
-instance Monoid Knuckles where
-  mempty = Knuckles 0 0 0
-
-instance Arbitrary Knuckles where
-  arbitrary = do
-    _knuckleDamage <- fromIntegral <$> chooseUpTo 5
-    _knuckleCalluses <- fromIntegral <$> chooseUpTo 5
-    _ticksSinceDamaged <- arbitrary
-    pure Knuckles{..}
-
--- | Likelihood that the character fighting with their fists will damage
--- themselves
-fistDamageChance :: Knuckles -> Float
-fistDamageChance knuckles
-  | calluses == 5 = 0
-  | otherwise = baseChance - (0.01 * fromIntegral calluses)
-  where
-    baseChance = 0.08
-    calluses = knuckles ^. knuckleCalluses
-
--- | Damage the knuckles by a level (capping at the max knuckle damage)
-damageKnuckles :: Knuckles -> Knuckles
-damageKnuckles = execState $ do
-  knuckleDamage %= min 5 . succ
-  ticksSinceDamaged .= 0
-
--- | Damage taken when fistfighting and 'fistDamageChance' has occurred
-fistfightingDamage :: Knuckles -> Hitpoints
-fistfightingDamage knuckles
-  | knuckles ^. knuckleDamage == 5 = 2
-  | otherwise = 1
-
-stepKnuckles :: Ticks -> Knuckles -> AppM Knuckles
-stepKnuckles ticks = execStateT . whenM (uses knuckleDamage (> 0)) $ do
-  ticksSinceDamaged += ticks
-  whenM (uses ticksSinceDamaged (>= 2000)) $ do
-    dam <- knuckleDamage <<.= 0
-    knuckleCalluses %= min 5 . (+ dam)
-    ticksSinceDamaged .= 0
-    lift $ say_ ["character", "body", "knuckles", "calluses"]
-
-
--- | Status of the character's body
-data Body = Body
-  { _knuckles :: !Knuckles
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Body
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Body
-makeLenses ''Body
-
-initialBody :: Body
-initialBody = Body { _knuckles = mempty }
-
---------------------------------------------------------------------------------
-
-data Character = Character
-  { _inventory           :: !Inventory
-  , _characterName       :: !(Maybe Text)
-  , _characterHitpoints' :: !Double
-  , _speed               :: !TicksPerTile
-  , _body                :: !Body
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Character
-makeFieldsNoPrefix ''Character
-
-characterHitpoints :: Character -> Hitpoints
-characterHitpoints = views characterHitpoints' floor
-
-scrollOffset :: Int
-scrollOffset = 5
-
-instance Draw Character where
-  draw _ = visibleRegion rloc rreg $ str "@"
-    where
-      rloc = Location (negate scrollOffset, negate scrollOffset)
-      rreg = (2 * scrollOffset, 2 * scrollOffset)
-  drawPriority = const maxBound -- Character should always be on top, for now
-
-instance Brain Character where
-  step ticks = execStateT $ do
-    positioned . characterHitpoints' %= \hp ->
-      if hp > fromIntegral initialHitpoints
-      then hp
-      else hp + hitpointRecoveryRate |*| ticks
-    modifyKL (positioned . body . knuckles) $ lift . stepKnuckles ticks
-
-instance Entity Character where
-  description _ = "yourself"
-  entityChar _ = "@"
-
-instance Arbitrary Character where
-  arbitrary = genericArbitrary
-
-initialHitpoints :: Hitpoints
-initialHitpoints = 10
-
-hitpointRecoveryRate :: Double `Per` Ticks
-hitpointRecoveryRate = 1.0 / (15 * coerce defaultSpeed)
-
-defaultSpeed :: TicksPerTile
-defaultSpeed = 100
-
-mkCharacter :: Character
-mkCharacter = Character
-  { _inventory           = mempty
-  , _characterName       = Nothing
-  , _characterHitpoints' = fromIntegral initialHitpoints
-  , _speed               = defaultSpeed
-  , _body                = initialBody
-  }
-
-defaultCharacterDamage :: Hitpoints
-defaultCharacterDamage = 1
-
--- | Returns the damage that the character currently does with an attack
--- TODO use double-handed/left-hand/right-hand here
-characterDamage :: Character -> Hitpoints
-characterDamage
-  = fromMaybe defaultCharacterDamage
-  . filter (/= 0)
-  . Just
-  . sumOf (inventory . wielded . wieldedItems . wieldableItem . Raw.damage)
-
--- | Is the character fully healed up to or past their initial hitpoints?
-isFullyHealed :: Character -> Bool
-isFullyHealed = (>= initialHitpoints) . characterHitpoints
-
--- | Is the character dead?
-isDead :: Character -> Bool
-isDead = (== 0) . characterHitpoints
-
-pickUpItem :: Item -> Character -> Character
-pickUpItem it = inventory . backpack %~ (it <|)
-
-damage :: Hitpoints -> Character -> Character
-damage (fromIntegral -> amount) = characterHitpoints' %~ \case
-  n | n <= amount -> 0
-    | otherwise  -> n - amount
-
-{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs b/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
deleted file mode 100644
index 368b03f25bed..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Common.hs
+++ /dev/null
@@ -1,290 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- |
--- Module      : Xanthous.Entities.Common
--- Description : Common data type definitions and utilities for entities
---
---------------------------------------------------------------------------------
-module Xanthous.Entities.Common
-  ( -- * Inventory
-    Inventory(..)
-  , HasInventory(..)
-  , backpack
-  , wielded
-  , items
-  , InventoryPosition(..)
-  , describeInventoryPosition
-  , inventoryPosition
-  , itemsWithPosition
-  , removeItemFromPosition
-
-    -- ** Wielded items
-  , Wielded(..)
-  , nothingWielded
-  , hands
-  , leftHand
-  , rightHand
-  , inLeftHand
-  , inRightHand
-  , doubleHanded
-  , Hand(..)
-  , itemsInHand
-  , inHand
-  , wieldInHand
-  , describeHand
-  , wieldedItems
-  , WieldedItem(..)
-  , wieldedItem
-  , wieldableItem
-  , asWieldedItem
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Aeson.Generic.DerivingVia
-import           Test.QuickCheck
-import           Test.QuickCheck.Checkers (EqProp)
---------------------------------------------------------------------------------
-import           Xanthous.Data (Positioned(..), positioned)
-import           Xanthous.Util.QuickCheck
-import           Xanthous.Game.State
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.RawTypes (WieldableItem, wieldable)
-import           Xanthous.Util (removeFirst, EqEqProp(..))
---------------------------------------------------------------------------------
-
-data WieldedItem = WieldedItem
-  { _wieldedItem :: Item
-  , _wieldableItem :: WieldableItem
-    -- ^ Invariant: item ^. itemType . wieldable ≡ Just wieldableItem
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           WieldedItem
-makeFieldsNoPrefix ''WieldedItem
-
-asWieldedItem :: Prism' Item WieldedItem
-asWieldedItem = prism' hither yon
- where
-   yon item = WieldedItem item <$> item ^. itemType . wieldable
-   hither (WieldedItem item _) = item
-
-instance Brain WieldedItem where
-  step ticks (Positioned p wi) =
-    over positioned (\i -> WieldedItem i $ wi ^. wieldableItem)
-    <$> step ticks (Positioned p $ wi ^. wieldedItem)
-
-instance Draw WieldedItem where
-  draw = draw . view wieldedItem
-
-instance Entity WieldedItem where
-  entityAttributes = entityAttributes . view wieldedItem
-  description = description . view wieldedItem
-  entityChar = entityChar . view wieldedItem
-
-instance Arbitrary WieldedItem where
-  arbitrary = genericArbitrary <&> \wi ->
-    wi & wieldedItem . itemType . wieldable ?~ wi ^. wieldableItem
-
-data Wielded
-  = DoubleHanded WieldedItem
-  | Hands { _leftHand :: !(Maybe WieldedItem)
-          , _rightHand :: !(Maybe WieldedItem)
-          }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Wielded
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'SumEnc 'ObjWithSingleField ]
-           Wielded
-
-
-nothingWielded :: Wielded
-nothingWielded = Hands Nothing Nothing
-
-hands :: Prism' Wielded (Maybe WieldedItem, Maybe WieldedItem)
-hands = prism' (uncurry Hands) $ \case
-  Hands l r -> Just (l, r)
-  _ -> Nothing
-
-leftHand :: Traversal' Wielded (Maybe WieldedItem)
-leftHand = hands . _1
-
-inLeftHand :: WieldedItem -> Wielded
-inLeftHand wi = Hands (Just wi) Nothing
-
-rightHand :: Traversal' Wielded (Maybe WieldedItem)
-rightHand = hands . _2
-
-inRightHand :: WieldedItem -> Wielded
-inRightHand wi = Hands Nothing (Just wi)
-
-doubleHanded :: Prism' Wielded WieldedItem
-doubleHanded = prism' DoubleHanded $ \case
-  DoubleHanded i -> Just i
-  _ -> Nothing
-
-wieldedItems :: Traversal' Wielded WieldedItem
-wieldedItems k (DoubleHanded wielded) = DoubleHanded <$> k wielded
-wieldedItems k (Hands l r) = Hands <$> _Just k l <*> _Just k r
-
-
-data Hand
-  = LeftHand
-  | RightHand
-  | BothHands
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Hand
-
-itemsInHand :: Hand -> Wielded -> [WieldedItem]
-itemsInHand LeftHand (DoubleHanded wi) = [wi]
-itemsInHand LeftHand (Hands lh _) = toList lh
-itemsInHand RightHand (DoubleHanded wi) = [wi]
-itemsInHand RightHand (Hands _ rh) = toList rh
-itemsInHand BothHands (DoubleHanded wi) = [wi]
-itemsInHand BothHands (Hands lh rh) = toList lh <> toList rh
-
-inHand :: Hand -> WieldedItem -> Wielded
-inHand LeftHand = inLeftHand
-inHand RightHand = inRightHand
-inHand BothHands = review doubleHanded
-
-wieldInHand :: Hand -> WieldedItem -> Wielded -> ([WieldedItem], Wielded)
-wieldInHand hand item w = (itemsInHand hand w, doWield)
-  where
-    doWield = case (hand, w) of
-      (LeftHand, Hands _ r) -> Hands (Just item) r
-      (LeftHand, DoubleHanded _) -> inLeftHand item
-      (RightHand, Hands l _) -> Hands l (Just item)
-      (RightHand, DoubleHanded _) -> inRightHand item
-      (BothHands, _) -> DoubleHanded item
-
-describeHand :: Hand -> Text
-describeHand LeftHand = "your left hand"
-describeHand RightHand = "your right hand"
-describeHand BothHands = "both hands"
-
-data Inventory = Inventory
-  { _backpack :: Vector Item
-  , _wielded :: Wielded
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Inventory
-  deriving EqProp via EqEqProp Inventory
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           Inventory
-makeFieldsNoPrefix ''Inventory
-
-items :: Traversal' Inventory Item
-items k (Inventory bp w) = Inventory
-  <$> traversed k bp
-  <*> (wieldedItems . wieldedItem) k w
-
-type instance Element Inventory = Item
-
-instance MonoFunctor Inventory where
-  omap = over items
-
-instance MonoFoldable Inventory where
-  ofoldMap = foldMapOf items
-  ofoldr = foldrOf items
-  ofoldl' = foldlOf' items
-  otoList = toListOf items
-  oall = allOf items
-  oany = anyOf items
-  onull = nullOf items
-  ofoldr1Ex = foldr1Of items
-  ofoldl1Ex' = foldl1Of' items
-  headEx = headEx . toListOf items
-  lastEx = lastEx . toListOf items
-
-instance MonoTraversable Inventory where
-  otraverse = traverseOf items
-
-instance Semigroup Inventory where
-  inv₁ <> inv₂ =
-    let backpack' = inv₁ ^. backpack <> inv₂ ^. backpack
-        (wielded', backpack'') = case (inv₁ ^. wielded, inv₂ ^. wielded) of
-          (wielded₁, wielded₂@(DoubleHanded _)) ->
-            (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem))
-          (wielded₁, wielded₂@(Hands (Just _) (Just _))) ->
-            (wielded₂, backpack' <> fromList (wielded₁ ^.. wieldedItems . wieldedItem))
-          (wielded₁, Hands Nothing Nothing) -> (wielded₁, backpack')
-          (Hands Nothing Nothing, wielded₂) -> (wielded₂, backpack')
-          (Hands (Just l₁) Nothing, Hands Nothing (Just r₂)) ->
-            (Hands (Just l₁) (Just r₂), backpack')
-          (wielded₁@(DoubleHanded _), wielded₂) ->
-            (wielded₁, backpack' <> fromList (wielded₂ ^.. wieldedItems . wieldedItem))
-          (Hands Nothing (Just r₁), Hands Nothing (Just r₂)) ->
-            (Hands Nothing (Just r₂), r₁ ^. wieldedItem <| backpack')
-          (Hands Nothing r₁, Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) r₁, backpack')
-          (Hands (Just l₁) Nothing, Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) Nothing, l₁ ^. wieldedItem <| backpack')
-          (Hands (Just l₁) (Just r₁), Hands Nothing (Just r₂)) ->
-            (Hands (Just l₁) (Just r₂), r₁ ^. wieldedItem <| backpack')
-          (Hands (Just l₁) (Just r₁), Hands (Just l₂) Nothing) ->
-            (Hands (Just l₂) (Just r₁), l₁ ^. wieldedItem <| backpack')
-    in Inventory backpack'' wielded'
-
-instance Monoid Inventory where
-  mempty = Inventory mempty $ Hands Nothing Nothing
-
-class HasInventory s a | s -> a where
-  inventory :: Lens' s a
-  {-# MINIMAL inventory #-}
-
--- | Representation for where in the inventory an item might be
-data InventoryPosition
-  = Backpack
-  | InHand Hand
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary InventoryPosition
-
--- | Return a human-readable description of the given 'InventoryPosition'
-describeInventoryPosition :: InventoryPosition -> Text
-describeInventoryPosition Backpack       = "In backpack"
-describeInventoryPosition (InHand hand)  = "Wielded, in " <> describeHand hand
-
--- | Given a position in the inventory, return a traversal on the inventory over
--- all the items in that position
-inventoryPosition :: InventoryPosition -> Traversal' Inventory Item
-inventoryPosition Backpack = backpack . traversed
-inventoryPosition (InHand LeftHand) = wielded . leftHand . _Just . wieldedItem
-inventoryPosition (InHand RightHand) = wielded . leftHand . _Just . wieldedItem
-inventoryPosition (InHand BothHands) = wielded . doubleHanded . wieldedItem
-
--- | A fold over all the items in the inventory accompanied by their position in
--- the inventory
---
--- Invariant: This will return items in the same order as 'items'
-itemsWithPosition :: Fold Inventory (InventoryPosition, Item)
-itemsWithPosition = folding $ (<>) <$> backpackItems <*> handItems
-  where
-    backpackItems = toListOf $ backpack . folded . to (Backpack ,)
-    handItems inv = case inv ^. wielded of
-       DoubleHanded i -> pure (InHand BothHands, i ^. wieldedItem)
-       Hands l r -> (l ^.. folded . wieldedItem . to (InHand LeftHand ,))
-                 <> (r ^.. folded . wieldedItem . to (InHand RightHand ,))
-
--- | Remove the first item equal to 'Item' from the given position in the
--- inventory
-removeItemFromPosition :: InventoryPosition -> Item -> Inventory -> Inventory
-removeItemFromPosition Backpack item inv
-  = inv & backpack %~ removeFirst (== item)
-removeItemFromPosition (InHand LeftHand) item inv
-  = inv & wielded . leftHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition (InHand RightHand) item inv
-  = inv & wielded . rightHand %~ filter ((/= item) . view wieldedItem)
-removeItemFromPosition (InHand BothHands) item inv
-  | has (wielded . doubleHanded . wieldedItem . filtered (== item)) inv
-  = inv & wielded .~ nothingWielded
-  | otherwise
-  = inv
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
deleted file mode 100644
index 3ea610795e98..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Creature.hs
+++ /dev/null
@@ -1,88 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Creature
-  ( -- * Creature
-    Creature(..)
-    -- ** Lenses
-  , creatureType
-  , hitpoints
-  , hippocampus
-  , inventory
-
-    -- ** Creature functions
-  , damage
-  , isDead
-  , visionRadius
-
-    -- * Hippocampus
-  , Hippocampus(..)
-    -- ** Lenses
-  , destination
-    -- ** Destination
-  , Destination(..)
-  , destinationFromPos
-    -- *** Lenses
-  , destinationPosition
-  , destinationProgress
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
---------------------------------------------------------------------------------
-import           Xanthous.AI.Gormlak
-import           Xanthous.Entities.RawTypes hiding
-                 (Creature, description, damage)
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Game.State
-import           Xanthous.Data
-import           Xanthous.Data.Entities
-import           Xanthous.Entities.Creature.Hippocampus
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
-import           Xanthous.Entities.Common (Inventory, HasInventory(..))
---------------------------------------------------------------------------------
-
-data Creature = Creature
-  { _creatureType   :: !CreatureType
-  , _hitpoints      :: !Hitpoints
-  , _hippocampus    :: !Hippocampus
-  , _inventory      :: !Inventory
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Draw via DrawRawCharPriority "_creatureType" 1000 Creature
-  deriving Arbitrary via GenericArbitrary Creature
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Creature
-makeFieldsNoPrefix ''Creature
-
-instance HasVisionRadius Creature where
-  visionRadius = const 50 -- TODO
-
-instance Brain Creature where
-  step = brainVia GormlakBrain
-  entityCanMove = const True
-
-instance Entity Creature where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksObject .~ True
-  description = view $ creatureType . Raw.description
-  entityChar = view $ creatureType . char
-  entityCollision = const $ Just Combat
-
---------------------------------------------------------------------------------
-
-damage :: Hitpoints -> Creature -> Creature
-damage amount = hitpoints %~ \hp ->
-  if hp <= amount
-  then 0
-  else hp - amount
-
-isDead :: Creature -> Bool
-isDead = views hitpoints (== 0)
-
-{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs b/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs
deleted file mode 100644
index d13ea8055c2b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Creature/Hippocampus.hs
+++ /dev/null
@@ -1,71 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Creature.Hippocampus
-  (-- * Hippocampus
-    Hippocampus(..)
-  , initialHippocampus
-    -- ** Lenses
-  , destination
-  , greetedCharacter
-    -- ** Destination
-  , Destination(..)
-  , destinationFromPos
-    -- *** Lenses
-  , destinationPosition
-  , destinationProgress
-  )
-where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
-import           Test.QuickCheck
-import           Test.QuickCheck.Arbitrary.Generic
---------------------------------------------------------------------------------
-import           Xanthous.Data
---------------------------------------------------------------------------------
-
-
-data Destination = Destination
-  { _destinationPosition :: !Position
-    -- | The progress towards the destination, tracked as an offset from the
-    -- creature's original position.
-    --
-    -- When this value reaches >= 1, the creature has reached their destination
-  , _destinationProgress :: !Tiles
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Destination
-instance Arbitrary Destination where arbitrary = genericArbitrary
-makeLenses ''Destination
-
-destinationFromPos :: Position -> Destination
-destinationFromPos _destinationPosition =
-  let _destinationProgress = 0
-  in Destination{..}
-
-data Hippocampus = Hippocampus
-  { _destination      :: !(Maybe Destination)
-  , -- | Has this creature greeted the character in any way yet?
-    --
-    -- Some creature types ignore this field
-    _greetedCharacter :: !Bool
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Hippocampus
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Hippocampus
-makeLenses ''Hippocampus
-
-initialHippocampus :: Hippocampus
-initialHippocampus = Hippocampus
-  { _destination      = Nothing
-  , _greetedCharacter = False
-  }
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs b/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs
deleted file mode 100644
index aa6c5fa4fc47..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Draw/Util.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module Xanthous.Entities.Draw.Util where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Brick.Widgets.Border.Style
-import Brick.Types (Edges(..))
---------------------------------------------------------------------------------
-
-borderFromEdges :: BorderStyle -> Edges Bool -> Char
-borderFromEdges bstyle edges = ($ bstyle) $ case edges of
-  Edges False False  False False -> const '☐'
-
-  Edges True  False  False False -> bsVertical
-  Edges False True   False False -> bsVertical
-  Edges False False  True  False -> bsHorizontal
-  Edges False False  False True  -> bsHorizontal
-
-  Edges True  True   False False -> bsVertical
-  Edges True  False  True  False -> bsCornerBR
-  Edges True  False  False True  -> bsCornerBL
-
-  Edges False True   True  False -> bsCornerTR
-  Edges False True   False True  -> bsCornerTL
-  Edges False False  True  True  -> bsHorizontal
-
-  Edges False True   True  True  -> bsIntersectT
-  Edges True  False  True  True  -> bsIntersectB
-  Edges True  True   False True  -> bsIntersectL
-  Edges True  True   True  False -> bsIntersectR
-
-  Edges True  True   True  True  -> bsIntersectFull
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs
deleted file mode 100644
index a0c037a1b4ed..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Entities () where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import qualified Test.QuickCheck.Gen as Gen
-import           Data.Aeson
---------------------------------------------------------------------------------
-import           Xanthous.Entities.Character
-import           Xanthous.Entities.Item
-import           Xanthous.Entities.Creature
-import           Xanthous.Entities.Environment
-import           Xanthous.Entities.Marker
-import           Xanthous.Game.State
-import           Xanthous.Util.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
---------------------------------------------------------------------------------
-
-instance Arbitrary SomeEntity where
-  arbitrary = Gen.oneof
-    [ SomeEntity <$> arbitrary @Character
-    , SomeEntity <$> arbitrary @Item
-    , SomeEntity <$> arbitrary @Creature
-    , SomeEntity <$> arbitrary @Wall
-    , SomeEntity <$> arbitrary @Door
-    , SomeEntity <$> arbitrary @GroundMessage
-    , SomeEntity <$> arbitrary @Staircase
-    , SomeEntity <$> arbitrary @Marker
-    ]
-
-instance FromJSON SomeEntity where
-  parseJSON = withObject "Entity" $ \obj -> do
-    (entityType :: Text) <- obj .: "type"
-    case entityType of
-      "Character" -> SomeEntity @Character <$> obj .: "data"
-      "Item" -> SomeEntity @Item <$> obj .: "data"
-      "Creature" -> SomeEntity @Creature <$> obj .: "data"
-      "Wall" -> SomeEntity @Wall <$> obj .: "data"
-      "Door" -> SomeEntity @Door <$> obj .: "data"
-      "GroundMessage" -> SomeEntity @GroundMessage <$> obj .: "data"
-      "Staircase" -> SomeEntity @Staircase <$> obj .: "data"
-      "Marker" -> SomeEntity @Marker <$> obj .: "data"
-      _ -> fail . unpack $ "Invalid entity type \"" <> entityType <> "\""
-
-deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameLevel
-  instance FromJSON GameLevel
-deriving via WithOptions '[ FieldLabelModifier '[Drop 1] ] GameState
-  instance FromJSON GameState
-
-instance Entity SomeEntity where
-  entityAttributes (SomeEntity ent) = entityAttributes ent
-  description (SomeEntity ent) = description ent
-  entityChar (SomeEntity ent) = entityChar ent
-  entityCollision (SomeEntity ent) = entityCollision ent
-
-instance Function SomeEntity where
-  function = functionJSON
-
-instance CoArbitrary SomeEntity where
-  coarbitrary = coarbitrary . encode
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot b/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot
deleted file mode 100644
index 519a862c6a5a..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Entities.hs-boot
+++ /dev/null
@@ -1,14 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Xanthous.Entities.Entities where
-
-import Test.QuickCheck
-import Data.Aeson
-import Xanthous.Game.State (SomeEntity, GameState, Entity)
-
-instance Arbitrary SomeEntity
-instance Function SomeEntity
-instance CoArbitrary SomeEntity
-instance FromJSON SomeEntity
-instance Entity SomeEntity
-
-instance FromJSON GameState
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs b/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
deleted file mode 100644
index b45a91eabed2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Environment.hs
+++ /dev/null
@@ -1,160 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Xanthous.Entities.Environment
-  (
-    -- * Walls
-    Wall(..)
-
-    -- * Doors
-  , Door(..)
-  , open
-  , closed
-  , locked
-  , unlockedDoor
-
-    -- * Messages
-  , GroundMessage(..)
-
-    -- * Stairs
-  , Staircase(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Test.QuickCheck
-import Brick (str)
-import Brick.Widgets.Border.Style (unicode)
-import Brick.Types (Edges(..))
-import Data.Aeson
-import Data.Aeson.Generic.DerivingVia
---------------------------------------------------------------------------------
-import Xanthous.Entities.Draw.Util
-import Xanthous.Data
-import Xanthous.Data.Entities
-import Xanthous.Game.State
-import Xanthous.Util.QuickCheck
---------------------------------------------------------------------------------
-
-data Wall = Wall
-  deriving stock (Show, Eq, Ord, Generic, Enum)
-  deriving anyclass (NFData, CoArbitrary, Function)
-
-instance ToJSON Wall where
-  toJSON = const $ String "Wall"
-
-instance FromJSON Wall where
-  parseJSON = withText "Wall" $ \case
-    "Wall" -> pure Wall
-    _      -> fail "Invalid Wall: expected Wall"
-
-instance Brain Wall where step = brainVia Brainless
-
-instance Entity Wall where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksVision .~ True
-    & blocksObject .~ True
-  description _ = "a wall"
-  entityChar _ = "┼"
-
-instance Arbitrary Wall where
-  arbitrary = pure Wall
-
-wallEdges :: (MonoFoldable mono, Element mono ~ SomeEntity)
-          => Neighbors mono -> Edges Bool
-wallEdges neighs = any (entityIs @Wall) <$> edges neighs
-
-instance Draw Wall where
-  drawWithNeighbors neighs _wall =
-    str . pure . borderFromEdges unicode $ wallEdges neighs
-
-data Door = Door
-  { _open   :: Bool
-  , _locked :: Bool
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary Door
-makeLenses ''Door
-
-instance Draw Door where
-  drawWithNeighbors neighs door
-    = str . pure . ($ door ^. open) $ case wallEdges neighs of
-        Edges True  False  False False -> vertDoor
-        Edges False True   False False -> vertDoor
-        Edges True  True   False False -> vertDoor
-        Edges False False  True  False -> horizDoor
-        Edges False False  False True  -> horizDoor
-        Edges False False  True  True  -> horizDoor
-        _                              -> allsidesDoor
-    where
-      horizDoor True = '␣'
-      horizDoor False = 'ᚔ'
-      vertDoor True = '['
-      vertDoor False = 'ǂ'
-      allsidesDoor True = '+'
-      allsidesDoor False = '▥'
-
-instance Brain Door where step = brainVia Brainless
-
-instance Entity Door where
-  entityAttributes door = defaultEntityAttributes
-    & blocksVision .~ not (door ^. open)
-  description door | door ^. open = "an open door"
-                   | otherwise    = "a closed door"
-  entityChar _ = "d"
-  entityCollision door | door ^. open = Nothing
-                       | otherwise = Just Stop
-
-closed :: Lens' Door Bool
-closed = open . involuted not
-
--- | A closed, unlocked door
-unlockedDoor :: Door
-unlockedDoor = Door
-  { _open = False
-  , _locked = False
-  }
-
---------------------------------------------------------------------------------
-
-newtype GroundMessage = GroundMessage Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary GroundMessage
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'TagSingleConstructors 'True
-                        , 'SumEnc 'ObjWithSingleField
-                        ]
-           GroundMessage
-  deriving Draw
-       via DrawStyledCharacter ('Just 'Yellow) 'Nothing "≈"
-           GroundMessage
-instance Brain GroundMessage where step = brainVia Brainless
-
-instance Entity GroundMessage where
-  description = const "a message on the ground. Press r. to read it."
-  entityChar = const "≈"
-  entityCollision = const Nothing
-
---------------------------------------------------------------------------------
-
-data Staircase = UpStaircase | DownStaircase
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Staircase
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ 'TagSingleConstructors 'True
-                        , 'SumEnc 'ObjWithSingleField
-                        ]
-           Staircase
-instance Brain Staircase where step = brainVia Brainless
-
-instance Draw Staircase where
-  draw UpStaircase = str "<"
-  draw DownStaircase = str ">"
-
-instance Entity Staircase where
-  description UpStaircase = "a staircase leading upwards"
-  description DownStaircase = "a staircase leading downwards"
-  entityChar UpStaircase = "<"
-  entityChar DownStaircase = ">"
-  entityCollision = const Nothing
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs b/users/grfn/xanthous/src/Xanthous/Entities/Item.hs
deleted file mode 100644
index eadd62569663..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Item.hs
+++ /dev/null
@@ -1,76 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Item
-  ( Item(..)
-  , itemType
-  , density
-  , volume
-  , newWithType
-  , isEdible
-  , weight
-  , fullDescription
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Test.QuickCheck (Arbitrary, CoArbitrary, Function)
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Aeson.Generic.DerivingVia
-import           Control.Monad.Random (MonadRandom)
---------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes (ItemType)
-import qualified Xanthous.Entities.RawTypes as Raw
-import           Xanthous.Game.State
-import           Xanthous.Data (Grams, Per, Cubic, Meters, (|*|))
-import           Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary))
-import           Xanthous.Random (choose, FiniteInterval(..))
---------------------------------------------------------------------------------
-
-data Item = Item
-  { _itemType :: ItemType
-  , _density  :: Grams `Per` Cubic Meters
-  , _volume   :: Cubic Meters
-  }
-  deriving stock (Eq, Show, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Draw via DrawRawChar "_itemType" Item
-  deriving Arbitrary via GenericArbitrary Item
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       Item
-makeLenses ''Item
-
--- deriving via (Brainless Item) instance Brain Item
-instance Brain Item where step = brainVia Brainless
-
-instance Entity Item where
-  description = view $ itemType . Raw.description
-  entityChar = view $ itemType . Raw.char
-  entityCollision = const Nothing
-
-newWithType :: MonadRandom m => ItemType -> m Item
-newWithType _itemType = do
-  _density <- choose . FiniteInterval $ _itemType ^. Raw.density
-  _volume  <- choose . FiniteInterval $ _itemType ^. Raw.volume
-  pure Item {..}
-
-isEdible :: Item -> Bool
-isEdible = Raw.isEdible . view itemType
-
--- | The weight of this item, calculated by multiplying its volume by the
--- density of its material
-weight :: Item -> Grams
-weight item = (item ^. density) |*| (item ^. volume)
-
--- | Describe the item in full detail
-fullDescription :: Item -> Text
-fullDescription item = unlines
-  [ item ^. itemType . Raw.description
-  , ""
-  , item ^. itemType . Raw.longDescription
-  , ""
-  , "volume: " <> tshow (item ^. volume)
-  , "density: " <> tshow (item ^. density)
-  , "weight: " <> tshow (weight item)
-  ]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs b/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs
deleted file mode 100644
index 14d02872ed4e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Marker.hs
+++ /dev/null
@@ -1,41 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Entities.Marker ( Marker(..) ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson
-import           Test.QuickCheck
-import qualified Graphics.Vty.Attributes as Vty
-import qualified Graphics.Vty.Image as Vty
-import           Brick.Widgets.Core (raw)
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import           Xanthous.Data.Entities (EntityAttributes(..))
---------------------------------------------------------------------------------
-
--- | Mark on the map - for use in debugging / development only.
-newtype Marker = Marker Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (Semigroup, Monoid, ToJSON, FromJSON, Arbitrary) via Text
-
-instance Brain Marker where step = brainVia Brainless
-
-instance Entity Marker where
-  entityAttributes = const EntityAttributes
-    { _blocksVision = False
-    , _blocksObject = False
-    , _collision = Stop
-    }
-  description (Marker m) = "[M] " <> m
-  entityChar = const $ "X" & style .~ markerStyle
-  entityCollision = const Nothing
-
-instance Draw Marker where
-  draw = const . raw $ Vty.char markerStyle 'X'
-  drawPriority = const maxBound
-
-markerStyle :: Vty.Attr
-markerStyle = Vty.defAttr
-  `Vty.withForeColor` Vty.red
-  `Vty.withBackColor` Vty.black
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs b/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
deleted file mode 100644
index a7021d76cf65..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/RawTypes.hs
+++ /dev/null
@@ -1,286 +0,0 @@
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE DuplicateRecordFields #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.RawTypes
-  (
-    EntityRaw(..)
-  , _Creature
-  , _Item
-
-    -- * Creatures
-  , CreatureType(..)
-  , hostile
-    -- ** Generation parameters
-  , CreatureGenerateParams(..)
-  , canGenerate
-    -- ** Language
-  , LanguageName(..)
-  , getLanguage
-    -- ** Attacks
-  , Attack(..)
-
-    -- * Items
-  , ItemType(..)
-    -- ** Item sub-types
-    -- *** Edible
-  , EdibleItem(..)
-  , isEdible
-    -- *** Wieldable
-  , WieldableItem(..)
-  , isWieldable
-
-    -- * Lens classes
-  , HasAttackMessage(..)
-  , HasAttacks(..)
-  , HasChance(..)
-  , HasChar(..)
-  , HasCreatureAttackMessage(..)
-  , HasDamage(..)
-  , HasDensity(..)
-  , HasDescription(..)
-  , HasEatMessage(..)
-  , HasEdible(..)
-  , HasEntityName(..)
-  , HasEquippedItem(..)
-  , HasFriendly(..)
-  , HasGenerateParams(..)
-  , HasHitpointsHealed(..)
-  , HasLanguage(..)
-  , HasLevelRange(..)
-  , HasLongDescription(..)
-  , HasMaxHitpoints(..)
-  , HasName(..)
-  , HasSayVerb(..)
-  , HasSpeed(..)
-  , HasVolume(..)
-  , HasWieldable(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Test.QuickCheck
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Aeson (ToJSON, FromJSON)
-import           Data.Interval (Interval, lowerBound', upperBound')
-import qualified Data.Interval as Interval
---------------------------------------------------------------------------------
-import           Xanthous.Messages (Message(..))
-import           Xanthous.Data (TicksPerTile, Hitpoints, Per, Grams, Cubic, Meters)
-import           Xanthous.Data.EntityChar
-import           Xanthous.Util.QuickCheck
-import           Xanthous.Generators.Speech (Language, gormlak, english)
-import           Xanthous.Orphans ()
-import           Xanthous.Util (EqProp, EqEqProp(..))
---------------------------------------------------------------------------------
-
--- | Identifiers for languages that creatures can speak.
---
--- Non-verbal or non-sentient creatures have Nothing as their language
---
--- At some point, we will likely want to make languages be defined in data files
--- somewhere, and reference them that way instead.
-data LanguageName = Gormlak | English
-  deriving stock (Show, Eq, Ord, Generic, Enum, Bounded)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary LanguageName
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ AllNullaryToStringTag 'True ]
-                       LanguageName
-
--- | Resolve a 'LanguageName' into an actual 'Language'
-getLanguage :: LanguageName -> Language
-getLanguage Gormlak = gormlak
-getLanguage English = english
-
--- | Natural attacks for creature types
-data Attack = Attack
-  { -- | the @{{creature}}@ @{{description}}@
-    _description :: !Message
-    -- | Damage dealt
-  , _damage      :: !Hitpoints
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Attack
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       Attack
-makeFieldsNoPrefix ''Attack
-
--- | Description for generating an item equipped to a creature
-data CreatureEquippedItem = CreatureEquippedItem
-  { -- | Name of the entity type to generate
-    _entityName :: !Text
-    -- | Chance of generating the item when generating the creature
-    --
-    -- A chance of 1.0 will always generate the item
-  , _chance :: !Double
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureEquippedItem
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       CreatureEquippedItem
-makeFieldsNoPrefix ''CreatureEquippedItem
-
-
-data CreatureGenerateParams = CreatureGenerateParams
-  { -- | Range of dungeon levels at which to generate this creature
-    _levelRange :: !(Interval Word)
-    -- | Item equipped to the creature
-  , _equippedItem :: !(Maybe CreatureEquippedItem)
-  }
-  deriving stock (Eq, Show, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureGenerateParams
-  deriving EqProp via EqEqProp CreatureGenerateParams
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       CreatureGenerateParams
-makeFieldsNoPrefix ''CreatureGenerateParams
-
-instance Ord CreatureGenerateParams where
-  compare
-    = (compare `on` lowerBound' . _levelRange)
-    <> (compare `on` upperBound' . _levelRange)
-    <> (compare `on` _equippedItem)
-
--- | Can a creature with these generate params be generated on this level?
-canGenerate
-  :: Word -- ^ Level number
-  -> CreatureGenerateParams
-  -> Bool
-canGenerate levelNumber gps = Interval.member levelNumber $ gps ^. levelRange
-
-data CreatureType = CreatureType
-  { _name           :: !Text
-  , _description    :: !Text
-  , _char           :: !EntityChar
-  , _maxHitpoints   :: !Hitpoints
-  , _friendly       :: !Bool
-  , _speed          :: !TicksPerTile
-  , _language       :: !(Maybe LanguageName)
-  , -- | The verb, in present tense, for when the creature says something
-    _sayVerb        :: !(Maybe Text)
-  , -- | The creature's natural attacks
-    _attacks        :: !(NonNull (Vector Attack))
-    -- | Parameters for generating the creature in levels
-  , _generateParams :: !(Maybe CreatureGenerateParams)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary CreatureType
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1]
-                        , OmitNothingFields 'True
-                        ]
-                       CreatureType
-makeFieldsNoPrefix ''CreatureType
-
-hostile :: Lens' CreatureType Bool
-hostile = friendly . involuted not
-
---------------------------------------------------------------------------------
-
-data EdibleItem = EdibleItem
-  { _hitpointsHealed :: !Int
-  , _eatMessage      :: !(Maybe Message)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary EdibleItem
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       EdibleItem
-makeFieldsNoPrefix ''EdibleItem
-
-data WieldableItem = WieldableItem
-  { _damage :: !Hitpoints
-    -- | Message to use when the character is using this item to attack a
-    --  creature.
-    --
-    -- Grammatically, this should be of the form "slash at the
-    -- {{creature.creatureType.name}} with your dagger"
-    --
-    -- = Parameters
-    --
-    -- [@creature@ (type: 'Creature')] The creature being attacked
-  , _attackMessage :: !(Maybe Message)
-    -- | Message to use when a creature is using this item to attack the
-    -- character.
-    --
-    -- Grammatically, should be of the form "The creature slashes you with its
-    -- dagger".
-    --
-    -- = Parameters
-    --
-    -- [@creature@ (type: 'Creature')] The creature doing the attacking
-    -- [@item@ (type: 'Item')] The item itself
-  , _creatureAttackMessage :: !(Maybe Message)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary WieldableItem
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       WieldableItem
-makeFieldsNoPrefix ''WieldableItem
-
---------------------------------------------------------------------------------
-
-data ItemType = ItemType
-  { _name            :: !Text
-  , _description     :: !Text
-  , _longDescription :: !Text
-  , _char            :: !EntityChar
-  , _density         :: !(Interval (Grams `Per` Cubic Meters))
-  , _volume          :: !(Interval (Cubic Meters))
-  , _edible          :: !(Maybe EdibleItem)
-  , _wieldable       :: !(Maybe WieldableItem)
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary ItemType
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-                       ItemType
-makeFieldsNoPrefix ''ItemType
-
-instance Ord ItemType where
-  compare x y
-    = compareOf name x y
-    <> compareOf description x y
-    <> compareOf longDescription x y
-    <> compareOf char x y
-    <> compareOf (density . to extractInterval) x y
-    <> compareOf (volume . to extractInterval) x y
-    <> compareOf edible x y
-    <> compareOf wieldable x y
-    where
-      compareOf l = comparing (view l)
-      extractInterval = lowerBound' &&& upperBound'
-
--- | Can this item be eaten?
-isEdible :: ItemType -> Bool
-isEdible = has $ edible . _Just
-
--- | Can this item be used as a weapon?
-isWieldable :: ItemType -> Bool
-isWieldable = has $ wieldable . _Just
-
---------------------------------------------------------------------------------
-
-data EntityRaw
-  = Creature !CreatureType
-  | Item !ItemType
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-  deriving Arbitrary via GenericArbitrary EntityRaw
-  deriving (FromJSON)
-       via WithOptions '[ SumEnc ObjWithSingleField ]
-                       EntityRaw
-makePrisms ''EntityRaw
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs b/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs
deleted file mode 100644
index 10f0d831934e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Entities.Raws
-  ( raws
-  , raw
-  , RawType(..)
-  , rawsWithType
-  ) where
---------------------------------------------------------------------------------
-import           Data.FileEmbed
-import qualified Data.Yaml as Yaml
-import           Xanthous.Prelude
-import           System.FilePath.Posix
---------------------------------------------------------------------------------
-import           Xanthous.Entities.RawTypes
-import           Xanthous.AI.Gormlak ()
---------------------------------------------------------------------------------
-rawRaws :: [(FilePath, ByteString)]
-rawRaws = $(embedDir "src/Xanthous/Entities/Raws")
-
-raws :: HashMap Text EntityRaw
-raws
-  = mapFromList
-  . map (bimap
-         (pack . takeBaseName)
-         (either (error . Yaml.prettyPrintParseException) id
-          . Yaml.decodeEither'))
-  $ rawRaws
-
-raw :: Text -> Maybe EntityRaw
-raw n = raws ^. at n
-
-class RawType (a :: Type) where
-  _RawType :: Prism' EntityRaw a
-
-instance RawType CreatureType where
-  _RawType = prism' Creature $ \case
-    Creature c -> Just c
-    _ -> Nothing
-
-instance RawType ItemType where
-  _RawType = prism' Item $ \case
-    Item i -> Just i
-    _ -> Nothing
-
-rawsWithType :: forall a. RawType a => HashMap Text a
-rawsWithType = mapFromList . itoListOf (ifolded . _RawType) $ raws
-
---------------------------------------------------------------------------------
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml
deleted file mode 100644
index 12c76fc14b2e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/broken-dagger.yaml
+++ /dev/null
@@ -1,24 +0,0 @@
-Item:
-  name: broken dagger
-  description: a short, broken dagger
-  longDescription: A short dagger with a twisted, chipped blade
-  char:
-    char: †
-    style:
-      foreground: black
-  wieldable:
-    damage: 3
-    attackMessage:
-      - slash at the {{creature.creatureType.name}} with your dagger
-      - stab the {{creature.creatureType.name}} with your dagger
-    creatureAttackMessage:
-      - The {{creature.creatureType.name}} slashes at you with its dagger.
-      - The {{creature.creatureType.name}} stabs you with its dagger.
-  # Just the steel, not the handle, for now
-  density: [7750 , 8050000]
-  # 15cm – 45cm
-  # ×
-  # 2cm – 3cm
-  # ×
-  # .5cm – 1cm
-  volume: [0.15, 1.35]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
deleted file mode 100644
index ad3d9cb147da..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/gormlak.yaml
+++ /dev/null
@@ -1,20 +0,0 @@
-Creature:
-  name: gormlak
-  description: a gormlak
-  longDescription: |
-    A chittering imp-like creature with bright yellow horns and sharp claws. It
-    adores shiny objects and gathers in swarms.
-  char:
-    char: g
-    style:
-      foreground: red
-  maxHitpoints: 5
-  speed: 125
-  friendly: false
-  language: Gormlak
-  sayVerb: yells
-  attacks:
-  - description:
-      - claws you
-      - slashes you with its claws
-    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml
deleted file mode 100644
index cdfcde616d21..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/husk.yaml
+++ /dev/null
@@ -1,26 +0,0 @@
-Creature:
-  name: husk
-  description: an empty husk of some humanoid creature
-  longDescription: |
-    An empty husk of a humanoid creature. All semblance of sentience has long
-    left its eyes; instead it shambles about aimlessly, always hungering for the
-    warmth of life.
-  char:
-    char: h
-    style:
-      foreground: black
-  maxHitpoints: 6
-  speed: 110
-  friendly: false
-  attacks:
-  - description:
-      - swings its arms at you
-      - elbows you
-    damage: 1
-  - description: kicks you
-    damage: 2
-  generateParams:
-    levelRange: [1, PosInf]
-    equippedItem:
-      entityName: broken-dagger
-      chance: 0.9
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml
deleted file mode 100644
index c0501a18a8e0..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/noodles.yaml
+++ /dev/null
@@ -1,14 +0,0 @@
-Item:
-  name: noodles
-  description: "a big bowl o' noodles"
-  longDescription: You know exactly what kind of noodles
-  char:
-    char: 'n'
-    style:
-      foreground: yellow
-  edible:
-    hitpointsHealed: 2
-    eatMessage:
-      - You slurp up the noodles. Yumm!
-  density: 500000
-  volume: 0.001
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
deleted file mode 100644
index fe427c94abf7..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/ooze.yaml
+++ /dev/null
@@ -1,15 +0,0 @@
-Creature:
-  name: ooze
-  description: an ooze
-  longDescription: |
-    A jiggling, amorphous, bright green caustic blob
-  char:
-    char: o
-    style:
-      foreground: green
-  maxHitpoints: 3
-  speed: 100
-  friendly: false
-  attacks:
-  - description: slams into you
-    damage: 1
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
deleted file mode 100644
index 3f4e133fe286..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/rock.yaml
+++ /dev/null
@@ -1,10 +0,0 @@
-Item:
-  name: rock
-  description: a rock
-  longDescription: a medium-sized rock made out of some unknown stone
-  char: .
-  wieldable:
-    damage: 1
-    attackMessage: hit the {{creature.creatureType.name}} in the head with your rock
-  density: [ 1500000, 2500000 ]
-  volume: [ 0.000125, 0.001 ]
diff --git a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml b/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml
deleted file mode 100644
index 7f9e1faffedb..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Entities/Raws/stick.yaml
+++ /dev/null
@@ -1,22 +0,0 @@
-Item:
-  name: stick
-  description: a wooden stick
-  longDescription: A sturdy branch broken off from some sort of tree
-  char:
-    char: ∤
-    style:
-      foreground: yellow
-  wieldable:
-    damage: 2
-    attackMessage:
-      - bonk the {{creature.creatureType.name}} over the head with your stick
-      - bash the {{creature.creatureType.name}} on the noggin with your stick
-      - whack the {{creature.creatureType.name}} with your stick
-    creatureAttackMessage:
-      - The {{creature.creatureType.name}} bonks you over the head with its stick.
-      - The {{creature.creatureType.name}} bashes you on the noggin with its stick.
-      - The {{creature.creatureType.name}} whacks you with its stick.
-  # https://www.sciencedirect.com/topics/agricultural-and-biological-sciences/wood-density
-  # it's a hard stick. so it's dense wood.
-  density: 890000 # g/m³
-  volume: [ 0.003, 0.006 ] # ≈3.5 cm radius × ≈1m length
diff --git a/users/grfn/xanthous/src/Xanthous/Game.hs b/users/grfn/xanthous/src/Xanthous/Game.hs
deleted file mode 100644
index 89c23f0de850..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game.hs
+++ /dev/null
@@ -1,73 +0,0 @@
-module Xanthous.Game
-  ( GameState(..)
-  , levels
-  , entities
-  , revealedPositions
-  , messageHistory
-  , randomGen
-  , promptState
-  , GamePromptState(..)
-
-  , getInitialState
-  , initialStateFromSeed
-
-  , positionedCharacter
-  , character
-  , characterPosition
-  , updateCharacterVision
-  , characterVisiblePositions
-  , entitiesAtCharacter
-  , revealedEntitiesAtPosition
-
-    -- * Messages
-  , MessageHistory(..)
-  , HasMessages(..)
-  , HasTurn(..)
-  , HasDisplayedTurn(..)
-  , pushMessage
-  , previousMessage
-  , nextTurn
-
-    -- * Collisions
-  , Collision(..)
-  , collisionAt
-
-    -- * App monad
-  , AppT(..)
-
-    -- * Saving the game
-  , saveGame
-  , loadGame
-  , saved
-
-    -- * Debug State
-  , DebugState(..)
-  , debugState
-  , allRevealed
-  ) where
---------------------------------------------------------------------------------
-import qualified Codec.Compression.Zlib as Zlib
-import           Codec.Compression.Zlib.Internal (DecompressError)
-import qualified Data.Aeson as JSON
-import           System.IO.Unsafe
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Xanthous.Game.State
-import           Xanthous.Game.Lenses
-import           Xanthous.Game.Arbitrary ()
-import           Xanthous.Entities.Entities ()
---------------------------------------------------------------------------------
-
-saveGame :: GameState -> LByteString
-saveGame = Zlib.compress . JSON.encode
-
-loadGame :: LByteString -> Maybe GameState
-loadGame = JSON.decode <=< decompressZlibMay
-  where
-    decompressZlibMay bs
-      = unsafeDupablePerformIO
-      $ (let r = Zlib.decompress bs in r `seq` pure (Just r))
-      `catch` \(_ :: DecompressError) -> pure Nothing
-
-saved :: Prism' LByteString GameState
-saved = prism' saveGame loadGame
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs b/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs
deleted file mode 100644
index 679bfe54597f..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Arbitrary.hs
+++ /dev/null
@@ -1,53 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Game.Arbitrary where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (foldMap)
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import           System.Random
-import           Data.Foldable (foldMap)
---------------------------------------------------------------------------------
-import           Xanthous.Data.Levels
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Entities ()
-import           Xanthous.Entities.Character
-import           Xanthous.Game.State
-import           Xanthous.Orphans ()
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
---------------------------------------------------------------------------------
-
-deriving via GenericArbitrary GameLevel instance Arbitrary GameLevel
-
-instance Arbitrary GameState where
-  arbitrary = do
-    chr <- arbitrary @Character
-    _upStaircasePosition <- arbitrary
-    _messageHistory <- arbitrary
-    levs <- arbitrary @(Levels GameLevel)
-    _levelRevealedPositions <-
-      fmap setFromList
-      . sublistOf
-      . foldMap (EntityMap.positions . _levelEntities)
-      $ levs
-    let (_characterEntityID, _levelEntities) =
-          EntityMap.insertAtReturningID _upStaircasePosition (SomeEntity chr)
-          $ levs ^. current . levelEntities
-        _levels = levs & current .~ GameLevel {..}
-    _randomGen <- mkStdGen <$> arbitrary
-    let _promptState = NoPrompt -- TODO
-    _activePanel <- arbitrary
-    _debugState <- arbitrary
-    let _autocommand = NoAutocommand
-    _memo <- arbitrary
-    _savefile <- arbitrary
-    pure $ GameState {..}
-
-
-instance CoArbitrary GameLevel
-instance Function GameLevel
-instance CoArbitrary GameState
-instance Function GameState
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs b/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
deleted file mode 100644
index 291dfd8b5e46..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Draw.hs
+++ /dev/null
@@ -1,224 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Game.Draw
-  ( drawGame
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Brick hiding (loc, on)
-import           Brick.Widgets.Border
-import           Brick.Widgets.Border.Style
-import           Brick.Widgets.Edit
-import           Control.Monad.State.Lazy (evalState)
-import           Control.Monad.State.Class ( get, MonadState, gets )
---------------------------------------------------------------------------------
-import           Xanthous.Data
-import           Xanthous.Data.App (ResourceName, Panel(..))
-import qualified Xanthous.Data.App as Resource
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Game.State
-import           Xanthous.Entities.Common (Wielded(..), wielded, backpack)
-import           Xanthous.Entities.Character
-import           Xanthous.Entities.Item (Item)
-import           Xanthous.Game
-                 ( characterPosition
-                 , character
-                 , revealedEntitiesAtPosition
-                 )
-import           Xanthous.Game.Prompt
-import           Xanthous.Orphans ()
-import Brick.Widgets.Center (hCenter)
-import Xanthous.Command (Keybinding (..), keybindings, Command, commandIsHidden)
-import Graphics.Vty.Input.Events (Modifier(..))
-import Graphics.Vty.Input (Key(..))
-import Brick.Widgets.Table
---------------------------------------------------------------------------------
-
-cursorPosition :: GameState -> Widget ResourceName -> Widget ResourceName
-cursorPosition game
-  | WaitingPrompt _ (Prompt _ _ (preview promptStatePosition -> Just pos) _ _)
-    <- game ^. promptState
-  = showCursor Resource.Prompt (pos ^. loc)
-  | otherwise
-  = showCursor Resource.Character (game ^. characterPosition . loc)
-
-drawMessages :: MessageHistory -> Widget ResourceName
-drawMessages = txtWrap . (<> " ") . unwords . reverse . oextract
-
-drawPromptState :: GamePromptState m -> Widget ResourceName
-drawPromptState NoPrompt = emptyWidget
-drawPromptState (WaitingPrompt msg (Prompt _ pt ps pri _)) =
-  case (pt, ps, pri) of
-    (SStringPrompt, StringPromptState edit, mDef) ->
-      txt msg
-      <+> txt (maybe "" (\def -> "(default: " <> def <> ") ") mDef)
-      <+> renderEditor (txt . fold) True edit
-    (SDirectionPrompt, DirectionPromptState, _) -> txtWrap msg
-    (SMenu, _, menuItems) ->
-      txtWrap msg
-      <=> foldl' (<=>) emptyWidget (map drawMenuItem $ itoList menuItems)
-    _ -> txtWrap msg
-  where
-    drawMenuItem (chr, MenuOption m _) =
-      str ("[" <> pure chr <> "] ") <+> txtWrap m
-
-drawEntities
-  :: forall m. MonadState GameState m
-  => m (Widget ResourceName)
-drawEntities = do
-  allEnts <- use entities
-  let entityPositions = EntityMap.positions allEnts
-      maxY = fromMaybe 0 $ maximumOf (folded . y) entityPositions
-      maxX = fromMaybe 0 $ maximumOf (folded . x) entityPositions
-      rows = traverse mkRow [0..maxY]
-      mkRow rowY = hBox <$> traverse (renderEntityAt . flip Position rowY) [0..maxX]
-      renderEntityAt pos
-        = renderTopEntity pos <$> revealedEntitiesAtPosition pos
-      renderTopEntity pos ents
-        = let neighbors = EntityMap.neighbors pos allEnts
-          in maybe (str " ") (drawWithNeighbors neighbors)
-             $ maximumBy (compare `on` drawPriority)
-             <$> fromNullable ents
-  vBox <$> rows
-
-drawMap :: MonadState GameState m => m (Widget ResourceName)
-drawMap = do
-  cursorPos <- gets cursorPosition
-  viewport Resource.MapViewport Both . cursorPos <$> drawEntities
-
-bullet :: Char
-bullet = '•'
-
-drawInventoryPanel :: GameState -> Widget ResourceName
-drawInventoryPanel game
-  =   drawWielded  (game ^. character . inventory . wielded)
-  <=> drawBackpack (game ^. character . inventory . backpack)
-  where
-    drawWielded (Hands Nothing Nothing) = emptyWidget
-    drawWielded (DoubleHanded i) =
-      txtWrap $ "You are holding " <> description i <> " in both hands"
-    drawWielded (Hands l r) = drawHand "left" l <=> drawHand "right" r
-    drawHand side = maybe emptyWidget $ \i ->
-      txtWrap ( "You are holding "
-              <> description i
-              <> " in your " <> side <> " hand"
-              )
-      <=> txt " "
-
-    drawBackpack :: Vector Item -> Widget ResourceName
-    drawBackpack Empty = txtWrap "Your backpack is empty right now."
-    drawBackpack backpackItems
-      = txtWrap ( "You are currently carrying the following items in your "
-                <> "backpack:")
-        <=> txt " "
-        <=> foldl' (<=>) emptyWidget
-            (map
-              (txtWrap . ((bullet <| " ") <>) . description)
-              backpackItems)
-
-drawHelpPanel :: Widget ResourceName
-drawHelpPanel
-  = txtWrap "To move in a direction or attack, use vi keys (hjklyubn):"
-  <=> txt " "
-  <=> hCenter keyStar
-  <=> txt " "
-  <=> cmds
-  where
-    keyStar
-      =   txt "y k u"
-      <=> txt " \\|/"
-      <=> txt "h-.-l"
-      <=> txt " /|\\"
-      <=> txt "b j n"
-
-    cmds
-      = renderTable
-      . alignRight 0
-      . setDefaultRowAlignment AlignTop
-      . surroundingBorder False
-      . rowBorders False
-      . columnBorders False
-      . table $ help <&> \(key, cmd) -> [ txt $ key <> " : "
-                                       , hLimitPercent 100 $ txtWrap cmd]
-
-    help =
-      extraHelp <>
-      keybindings
-        ^.. ifolded
-          . filtered (not . commandIsHidden)
-          . withIndex
-          . to (bimap displayKeybinding displayCommand)
-    extraHelp
-      = [("Shift-Dir", "Auto-move")]
-
-    displayCommand = tshow @Command
-    displayKeybinding (Keybinding k mods) = foldMap showMod mods <> showKey k
-
-    showMod MCtrl  = "Ctrl-"
-    showMod MShift = "Shift-"
-    showMod MAlt   = "Alt-"
-    showMod MMeta  = "Meta-"
-
-    showKey (KChar c) = pack [c]
-    showKey KEsc = "<Esc>"
-    showKey KBS = "<Backspace>"
-    showKey KEnter = "<Enter>"
-    showKey KLeft = "<Left>"
-    showKey KRight = "<Right>"
-    showKey KUp = "<Up>"
-    showKey KDown = "<Down>"
-    showKey KUpLeft = "<UpLeft>"
-    showKey KUpRight = "<UpRight>"
-    showKey KDownLeft = "<DownLeft>"
-    showKey KDownRight = "<DownRight>"
-    showKey KCenter = "<Center>"
-    showKey (KFun n) = "<F" <> tshow n <> ">"
-    showKey KBackTab = "<BackTab>"
-    showKey KPrtScr = "<PrtScr>"
-    showKey KPause = "<Pause>"
-    showKey KIns = "<Ins>"
-    showKey KHome = "<Home>"
-    showKey KPageUp = "<PageUp>"
-    showKey KDel = "<Del>"
-    showKey KEnd = "<End>"
-    showKey KPageDown = "<PageDown>"
-    showKey KBegin = "<Begin>"
-    showKey KMenu = "<Menu>"
-
-drawPanel :: GameState -> Panel -> Widget ResourceName
-drawPanel game panel
-  = border
-  . hLimit 35
-  . viewport (Resource.Panel panel) Vertical
-  $ case panel of
-      HelpPanel -> drawHelpPanel
-      InventoryPanel -> drawInventoryPanel game
-      ItemDescriptionPanel desc -> txtWrap desc
-
-drawCharacterInfo :: Character -> Widget ResourceName
-drawCharacterInfo ch = txt " " <+> charName <+> charHitpoints
-  where
-    charName | Just n <- ch ^. characterName
-             = txt $ n <> " "
-             | otherwise
-             = emptyWidget
-    charHitpoints
-        = txt "Hitpoints: "
-      <+> txt (tshow $ let Hitpoints hp = characterHitpoints ch in hp)
-
-drawGame :: GameState -> [Widget ResourceName]
-drawGame = evalState $ do
-  game <- get
-  drawnMap <- drawMap
-  pure
-    . pure
-    . withBorderStyle unicode
-    $ case game ^. promptState of
-        NoPrompt -> drawMessages (game ^. messageHistory)
-        _ -> emptyWidget
-    <=> drawPromptState (game ^. promptState)
-    <=>
-    (maybe emptyWidget (drawPanel game) (game ^. activePanel)
-    <+> border drawnMap
-    )
-    <=> drawCharacterInfo (game ^. character)
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Env.hs b/users/grfn/xanthous/src/Xanthous/Game/Env.hs
deleted file mode 100644
index 5d7b275c8a0b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Env.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Game.Env
-  ( Config(..)
-  , defaultConfig
-  , disableSaving
-  , GameEnv(..)
-  , eventChan
-  , config
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Brick.BChan (BChan)
-import Xanthous.Data.App (AppEvent)
---------------------------------------------------------------------------------
-
-data Config = Config
-  { _disableSaving :: Bool
-  }
-  deriving stock (Generic, Show, Eq)
-makeLenses ''Config
-{-# ANN Config ("HLint: ignore Use newtype instead of data" :: String) #-}
-
-defaultConfig :: Config
-defaultConfig = Config
-  { _disableSaving = False
-  }
-
---------------------------------------------------------------------------------
-
-data GameEnv = GameEnv
-  { _eventChan :: BChan AppEvent
-  , _config :: Config
-  }
-  deriving stock (Generic)
-makeLenses ''GameEnv
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs b/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs
deleted file mode 100644
index c692a3b47944..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Lenses.hs
+++ /dev/null
@@ -1,178 +0,0 @@
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE AllowAmbiguousTypes   #-}
---------------------------------------------------------------------------------
-module Xanthous.Game.Lenses
-  ( clearMemo
-  , positionedCharacter
-  , character
-  , characterPosition
-  , updateCharacterVision
-  , characterVisiblePositions
-  , characterVisibleEntities
-  , positionIsCharacterVisible
-  , getInitialState
-  , initialStateFromSeed
-  , entitiesAtCharacter
-  , revealedEntitiesAtPosition
-  , hearingRadius
-
-    -- * Collisions
-  , Collision(..)
-  , entitiesCollision
-  , collisionAt
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           System.Random
-import           Control.Monad.State
-import           Control.Monad.Random (getRandom)
---------------------------------------------------------------------------------
-import           Xanthous.Game.State
-import qualified Xanthous.Game.Memo as Memo
-import           Xanthous.Data
-import           Xanthous.Data.Levels
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Data.EntityMap.Graphics
-                 (visiblePositions, visibleEntities)
-import           Xanthous.Data.VectorBag
-import           Xanthous.Entities.Character (Character, mkCharacter)
-import           {-# SOURCE #-} Xanthous.Entities.Entities ()
-import           Xanthous.Game.Memo (emptyMemoState, MemoState)
-import           Xanthous.Data.Memo (fillWithM, Memoized)
---------------------------------------------------------------------------------
-
-getInitialState :: IO GameState
-getInitialState = initialStateFromSeed <$> getRandom
-
-initialStateFromSeed :: Int -> GameState
-initialStateFromSeed seed =
-  let _randomGen = mkStdGen seed
-      chr = mkCharacter
-      _upStaircasePosition = Position 0 0
-      (_characterEntityID, _levelEntities)
-        = EntityMap.insertAtReturningID
-          _upStaircasePosition
-          (SomeEntity chr)
-          mempty
-      _levelRevealedPositions = mempty
-      level = GameLevel {..}
-      _levels = oneLevel level
-      _messageHistory = mempty
-      _promptState = NoPrompt
-      _activePanel = Nothing
-      _debugState = DebugState
-        { _allRevealed = False
-        }
-      _savefile = Nothing
-      _autocommand = NoAutocommand
-      _memo = emptyMemoState
-  in GameState {..}
-
-clearMemo :: MonadState GameState m => Lens' MemoState (Memoized k v) -> m ()
-clearMemo l = memo %= Memo.clear l
-
-positionedCharacter :: Lens' GameState (Positioned Character)
-positionedCharacter = lens getPositionedCharacter setPositionedCharacter
-  where
-    setPositionedCharacter :: GameState -> Positioned Character -> GameState
-    setPositionedCharacter game chr
-      = game
-      &  entities . at (game ^. characterEntityID)
-      ?~ fmap SomeEntity chr
-
-    getPositionedCharacter :: GameState -> Positioned Character
-    getPositionedCharacter game
-      = over positioned
-        ( fromMaybe (error "Invariant error: Character was not a character!")
-        . downcastEntity
-        )
-      . fromMaybe (error "Invariant error: Character not found!")
-      $ EntityMap.lookupWithPosition
-        (game ^. characterEntityID)
-        (game ^. entities)
-
-
-character :: Lens' GameState Character
-character = positionedCharacter . positioned
-
-characterPosition :: Lens' GameState Position
-characterPosition = positionedCharacter . position
-
--- TODO make this dynamic
-visionRadius :: Word
-visionRadius = 12
-
--- TODO make this dynamic
-hearingRadius :: Word
-hearingRadius = 12
-
--- | Update the revealed entities at the character's position based on their
--- vision
-updateCharacterVision :: GameState -> GameState
-updateCharacterVision = execState $ do
-  positions <- characterVisiblePositions
-  revealedPositions <>= positions
-
-characterVisiblePositions :: MonadState GameState m => m (Set Position)
-characterVisiblePositions = do
-  charPos <- use characterPosition
-  fillWithM
-    (memo . Memo.characterVisiblePositions)
-    charPos
-    (uses entities $ visiblePositions charPos visionRadius)
-
-characterVisibleEntities :: GameState -> EntityMap.EntityMap SomeEntity
-characterVisibleEntities game =
-  let charPos = game ^. characterPosition
-  in visibleEntities charPos visionRadius $ game ^. entities
-
-positionIsCharacterVisible :: MonadState GameState m => Position -> m Bool
-positionIsCharacterVisible p = (p `elem`) <$> characterVisiblePositions
--- ^ TODO optimize
-
-entitiesCollision
-  :: ( Functor f
-    , forall xx. MonoFoldable (f xx)
-    , Element (f SomeEntity) ~ SomeEntity
-    , Element (f (Maybe Collision)) ~ Maybe Collision
-    , Show (f (Maybe Collision))
-    , Show (f SomeEntity)
-    )
-  => f SomeEntity
-  -> Maybe Collision
-entitiesCollision = join . maximumMay . fmap entityCollision
-
-collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
-collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision
-
-entitiesAtCharacter :: Lens' GameState (VectorBag SomeEntity)
-entitiesAtCharacter = lens getter setter
-  where
-    getter gs = gs ^. entities . EntityMap.atPosition (gs ^. characterPosition)
-    setter gs ents = gs
-      & entities . EntityMap.atPosition (gs ^. characterPosition) .~ ents
-
--- | Returns all entities at the given position that are revealed to the
--- character.
---
--- Concretely, this is either entities that are *currently* visible to the
--- character, or entities, that are immobile and that the character has seen
--- before
-revealedEntitiesAtPosition
-  :: MonadState GameState m
-  => Position
-  -> m (VectorBag SomeEntity)
-revealedEntitiesAtPosition p = do
-  allRev <- use $ debugState . allRevealed
-  cvps <- characterVisiblePositions
-  entitiesAtPosition <- use $ entities . EntityMap.atPosition p
-  revealed <- use revealedPositions
-  let immobileEntitiesAtPosition = filter (not . entityCanMove) entitiesAtPosition
-  pure $ if | allRev || p `member` cvps
-              -> entitiesAtPosition
-            | p `member` revealed
-              -> immobileEntitiesAtPosition
-            | otherwise
-              -> mempty
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Memo.hs b/users/grfn/xanthous/src/Xanthous/Game/Memo.hs
deleted file mode 100644
index 154063b5dde2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Memo.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
--- | Memoized versions of calculations
---------------------------------------------------------------------------------
-module Xanthous.Game.Memo
-  ( MemoState
-  , emptyMemoState
-  , clear
-    -- ** Memo lenses
-  , characterVisiblePositions
-
-    -- * Memoized values
-  , Memoized(UnMemoized)
-  , memoizeWith
-  , getMemoized
-  , runMemoized
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Data.Aeson (ToJSON, FromJSON)
-import Data.Aeson.Generic.DerivingVia
-import Test.QuickCheck (CoArbitrary, Function, Arbitrary)
---------------------------------------------------------------------------------
-import Xanthous.Data (Position)
-import Xanthous.Data.Memo
-import Xanthous.Util.QuickCheck (GenericArbitrary(GenericArbitrary))
---------------------------------------------------------------------------------
-
--- | Memoized calculations on the game state
-data MemoState = MemoState
-  { -- | Memoized version of 'Xanthous.Game.Lenses.characterVisiblePositions',
-    -- memoized with the position of the character
-    _characterVisiblePositions :: Memoized Position (Set Position)
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary MemoState
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           MemoState
-makeLenses ''MemoState
-
-emptyMemoState :: MemoState
-emptyMemoState = MemoState { _characterVisiblePositions = UnMemoized }
-{-# INLINE emptyMemoState #-}
-
-clear :: ASetter' MemoState (Memoized key val) -> MemoState -> MemoState
-clear = flip set UnMemoized
-{-# INLINE clear #-}
-
-{-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs
deleted file mode 100644
index 2d6c0a280f41..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs
+++ /dev/null
@@ -1,359 +0,0 @@
-{-# LANGUAGE DeriveFunctor        #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving   #-}
-{-# LANGUAGE GADTs                #-}
---------------------------------------------------------------------------------
-module Xanthous.Game.Prompt
-  ( PromptType(..)
-  , SPromptType(..)
-  , SingPromptType(..)
-  , PromptCancellable(..)
-  , PromptResult(..)
-  , PromptState(..)
-  , promptStatePosition
-  , MenuOption(..)
-  , mkMenuItems
-  , PromptInput
-  , Prompt(..)
-  , mkPrompt
-  , mkStringPrompt
-  , mkStringPromptWithDefault
-  , mkMenu
-  , mkPointOnMapPrompt
-  , mkFirePrompt
-  , isCancellable
-  , submitPrompt
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Brick.Widgets.Edit (Editor, editorText, getEditContents)
-import           Test.QuickCheck
-import           Test.QuickCheck.Arbitrary.Generic
---------------------------------------------------------------------------------
-import           Xanthous.Util (smallestNotIn, AlphaChar (..))
-import           Xanthous.Data (Direction, Position, Tiles)
-import           Xanthous.Data.App (ResourceName)
-import qualified Xanthous.Data.App as Resource
---------------------------------------------------------------------------------
-
-data PromptType where
-  StringPrompt    :: PromptType
-  Confirm         :: PromptType
-  Menu            :: Type -> PromptType
-  DirectionPrompt :: PromptType
-  PointOnMap      :: PromptType
-  -- | Throw an item or fire a projectile weapon. Prompt is to select the
-  -- direction
-  Fire            :: PromptType
-  Continue        :: PromptType
-  deriving stock (Generic)
-
-instance Show PromptType where
-  show StringPrompt = "StringPrompt"
-  show Confirm = "Confirm"
-  show (Menu _) = "Menu"
-  show DirectionPrompt = "DirectionPrompt"
-  show PointOnMap = "PointOnMap"
-  show Continue = "Continue"
-  show Fire = "Fire"
-
-data SPromptType :: PromptType -> Type where
-  SStringPrompt    :: SPromptType 'StringPrompt
-  SConfirm         :: SPromptType 'Confirm
-  SMenu            :: SPromptType ('Menu a)
-  SDirectionPrompt :: SPromptType 'DirectionPrompt
-  SPointOnMap      :: SPromptType 'PointOnMap
-  SContinue        :: SPromptType 'Continue
-  SFire            :: SPromptType 'Fire
-
-instance NFData (SPromptType pt) where
-  rnf SStringPrompt = ()
-  rnf SConfirm = ()
-  rnf SMenu = ()
-  rnf SDirectionPrompt = ()
-  rnf SPointOnMap = ()
-  rnf SContinue = ()
-  rnf SFire = ()
-
-class SingPromptType pt where singPromptType :: SPromptType pt
-instance SingPromptType 'StringPrompt where singPromptType = SStringPrompt
-instance SingPromptType 'Confirm where singPromptType = SConfirm
-instance SingPromptType 'DirectionPrompt where singPromptType = SDirectionPrompt
-instance SingPromptType 'PointOnMap where singPromptType = SPointOnMap
-instance SingPromptType 'Continue where singPromptType = SContinue
-instance SingPromptType 'Fire where singPromptType = SFire
-
-instance Show (SPromptType pt) where
-  show SStringPrompt    = "SStringPrompt"
-  show SConfirm         = "SConfirm"
-  show SMenu            = "SMenu"
-  show SDirectionPrompt = "SDirectionPrompt"
-  show SPointOnMap      = "SPointOnMap"
-  show SContinue        = "SContinue"
-  show SFire            = "SFire"
-
-data PromptCancellable
-  = Cancellable
-  | Uncancellable
-  deriving stock (Show, Eq, Ord, Enum, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-
-instance Arbitrary PromptCancellable where
-  arbitrary = genericArbitrary
-
-data PromptResult (pt :: PromptType) where
-  StringResult     :: Text      -> PromptResult 'StringPrompt
-  ConfirmResult    :: Bool      -> PromptResult 'Confirm
-  MenuResult       :: forall a. a    -> PromptResult ('Menu a)
-  DirectionResult  :: Direction -> PromptResult 'DirectionPrompt
-  PointOnMapResult :: Position  -> PromptResult 'PointOnMap
-  FireResult       :: Position  -> PromptResult 'Fire
-  ContinueResult   ::             PromptResult 'Continue
-
-instance Arbitrary (PromptResult 'StringPrompt) where
-  arbitrary = StringResult <$> arbitrary
-
-instance Arbitrary (PromptResult 'Confirm) where
-  arbitrary = ConfirmResult <$> arbitrary
-
-instance Arbitrary a => Arbitrary (PromptResult ('Menu a)) where
-  arbitrary = MenuResult <$> arbitrary
-
-instance Arbitrary (PromptResult 'DirectionPrompt) where
-  arbitrary = DirectionResult <$> arbitrary
-
-instance Arbitrary (PromptResult 'PointOnMap) where
-  arbitrary = PointOnMapResult <$> arbitrary
-
-instance Arbitrary (PromptResult 'Continue) where
-  arbitrary = pure ContinueResult
-
-instance Arbitrary (PromptResult 'Fire) where
-  arbitrary = FireResult <$> arbitrary
-
---------------------------------------------------------------------------------
-
-data PromptState pt where
-  StringPromptState
-    :: Editor Text ResourceName     -> PromptState 'StringPrompt
-  DirectionPromptState  ::            PromptState 'DirectionPrompt
-  ContinuePromptState   ::            PromptState 'Continue
-  ConfirmPromptState    ::            PromptState 'Confirm
-  MenuPromptState       :: forall a.       PromptState ('Menu a)
-  PointOnMapPromptState :: Position -> PromptState 'PointOnMap
-  FirePromptState       :: Position -> PromptState 'Fire
-
-instance NFData (PromptState pt) where
-  rnf sps@(StringPromptState ed) = sps `deepseq` ed `deepseq` ()
-  rnf DirectionPromptState = ()
-  rnf ContinuePromptState = ()
-  rnf ConfirmPromptState = ()
-  rnf MenuPromptState = ()
-  rnf pomps@(PointOnMapPromptState pos) = pomps `deepseq` pos `deepseq` ()
-  rnf fps@(FirePromptState pos) = fps `deepseq` pos `deepseq` ()
-
-instance Arbitrary (PromptState 'StringPrompt) where
-  arbitrary = StringPromptState <$> arbitrary
-
-instance Arbitrary (PromptState 'DirectionPrompt) where
-  arbitrary = pure DirectionPromptState
-
-instance Arbitrary (PromptState 'Continue) where
-  arbitrary = pure ContinuePromptState
-
-instance Arbitrary (PromptState ('Menu a)) where
-  arbitrary = pure MenuPromptState
-
-instance Arbitrary (PromptState 'Fire) where
-  arbitrary = FirePromptState <$> arbitrary
-
-instance CoArbitrary (PromptState 'StringPrompt) where
-  coarbitrary (StringPromptState ed) = coarbitrary ed
-
-instance CoArbitrary (PromptState 'DirectionPrompt) where
-  coarbitrary DirectionPromptState = coarbitrary ()
-
-instance CoArbitrary (PromptState 'Continue) where
-  coarbitrary ContinuePromptState = coarbitrary ()
-
-instance CoArbitrary (PromptState ('Menu a)) where
-  coarbitrary MenuPromptState = coarbitrary ()
-
-instance CoArbitrary (PromptState 'Fire) where
-  coarbitrary (FirePromptState pos) = coarbitrary pos
-
-deriving stock instance Show (PromptState pt)
-
--- | Traversal over the position for the prompt types with positions in their
--- prompt state (currently 'Fire' and 'PointOnMap')
-promptStatePosition :: forall pt. Traversal' (PromptState pt) Position
-promptStatePosition _ ps@(StringPromptState _) = pure ps
-promptStatePosition _ DirectionPromptState = pure DirectionPromptState
-promptStatePosition _ ContinuePromptState = pure ContinuePromptState
-promptStatePosition _ ConfirmPromptState = pure ConfirmPromptState
-promptStatePosition _ MenuPromptState = pure MenuPromptState
-promptStatePosition f (PointOnMapPromptState p) = PointOnMapPromptState <$> f p
-promptStatePosition f (FirePromptState p) = FirePromptState <$> f p
-
-data MenuOption a = MenuOption Text a
-  deriving stock (Eq, Generic, Functor)
-  deriving anyclass (NFData, CoArbitrary, Function)
-
-instance Comonad MenuOption where
-  extract (MenuOption _ x) = x
-  extend cok mo@(MenuOption text _) = MenuOption text (cok mo)
-
-mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a))
-            => f
-            -> Map Char (MenuOption a)
-mkMenuItems = flip foldl' mempty $ \items (chr, option) ->
-  let chr' = if has (ix chr) items
-             then getAlphaChar . smallestNotIn . map AlphaChar $ keys items
-             else chr
-  in items & at chr' ?~ option
-
-instance Show (MenuOption a) where
-  show (MenuOption m _) = show m
-
-type family PromptInput (pt :: PromptType) :: Type where
-  PromptInput ('Menu a)     = Map Char (MenuOption a)
-  PromptInput 'PointOnMap   = Position -- Character pos
-  PromptInput 'Fire         = (Position, Tiles) -- Nearest enemy, range
-  PromptInput 'StringPrompt = Maybe Text -- Default value
-  PromptInput _ = ()
-
-data Prompt (m :: Type -> Type) where
-  Prompt
-    :: forall (pt :: PromptType)
-        (m :: Type -> Type).
-      PromptCancellable
-    -> SPromptType pt
-    -> PromptState pt
-    -> PromptInput pt
-    -> (PromptResult pt -> m ())
-    -> Prompt m
-
-instance Show (Prompt m) where
-  show (Prompt c pt ps pri _)
-    = "(Prompt "
-    <> show c <> " "
-    <> show pt <> " "
-    <> show ps <> " "
-    <> showPri
-    <> " <function>)"
-    where showPri = case pt of
-            SMenu -> show pri
-            _ -> "()"
-
-instance NFData (Prompt m) where
-  rnf (Prompt c SMenu ps pri cb)
-            = c
-    `deepseq` ps
-    `deepseq` pri
-    `seq` cb
-    `seq` ()
-  rnf (Prompt c spt ps pri cb)
-            = c
-    `deepseq` spt
-    `deepseq` ps
-    `deepseq` pri
-    `seq` cb
-    `seq` ()
-
-instance CoArbitrary (m ()) => CoArbitrary (Prompt m) where
-  coarbitrary (Prompt c SStringPrompt ps pri cb) =
-    variant @Int 1 . coarbitrary (c, ps, pri, cb)
-  coarbitrary (Prompt c SConfirm _ pri cb) = -- TODO fill in prompt state
-    variant @Int 2 . coarbitrary (c, pri, cb)
-  coarbitrary (Prompt c SMenu _ps _pri _cb) =
-    variant @Int 3 . coarbitrary c {-, ps, pri, cb -}
-  coarbitrary (Prompt c SDirectionPrompt ps pri cb) =
-    variant @Int 4 . coarbitrary (c, ps, pri, cb)
-  coarbitrary (Prompt c SPointOnMap _ pri cb) = -- TODO fill in prompt state
-    variant @Int 5 . coarbitrary (c, pri, cb)
-  coarbitrary (Prompt c SContinue ps pri cb) =
-    variant @Int 6 . coarbitrary (c, ps, pri, cb)
-  coarbitrary (Prompt c SFire ps pri cb) =
-    variant @Int 7 . coarbitrary (c, ps, pri, cb)
-
--- instance Function (Prompt m) where
---   function = functionMap toTuple _fromTuple
---     where
---       toTuple (Prompt c pt ps pri cb) = (c, pt, ps, pri, cb)
-
-
-mkPrompt
-  :: (PromptInput pt ~ ())
-  => PromptCancellable       -- ^ Is the prompt cancellable or not?
-  -> SPromptType pt          -- ^ The type of the prompt
-  -> (PromptResult pt -> m ()) -- ^ Function to call when the prompt is complete
-  -> Prompt m
-mkPrompt c pt@SDirectionPrompt cb = Prompt c pt DirectionPromptState () cb
-mkPrompt c pt@SContinue cb = Prompt c pt ContinuePromptState () cb
-mkPrompt c pt@SConfirm cb = Prompt c pt ConfirmPromptState () cb
-
-mkStringPrompt
-  :: PromptCancellable                  -- ^ Is the prompt cancellable or not?
-  -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete
-  -> Prompt m
-mkStringPrompt c =
-  let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
-  in Prompt c SStringPrompt ps Nothing
-
-mkStringPromptWithDefault
-  :: PromptCancellable                  -- ^ Is the prompt cancellable or not?
-  -> Text                               -- ^ Default value for the prompt
-  -> (PromptResult 'StringPrompt -> m ()) -- ^ Function to call when the prompt is complete
-  -> Prompt m
-mkStringPromptWithDefault c def =
-  let ps = StringPromptState $ editorText Resource.Prompt (Just 1) ""
-  in Prompt c SStringPrompt ps (Just def)
-
-mkMenu
-  :: forall a m.
-    PromptCancellable
-  -> Map Char (MenuOption a) -- ^ Menu items
-  -> (PromptResult ('Menu a) -> m ())
-  -> Prompt m
-mkMenu c = Prompt c SMenu MenuPromptState
-
-mkPointOnMapPrompt
-  :: PromptCancellable
-  -> Position
-  -> (PromptResult 'PointOnMap -> m ())
-  -> Prompt m
-mkPointOnMapPrompt c pos = Prompt c SPointOnMap (PointOnMapPromptState pos) pos
-
-mkFirePrompt
-  :: PromptCancellable
-  -> Position -- ^ Initial position
-  -> Tiles    -- ^ Range
-  -> (PromptResult 'Fire -> m ())
-  -> Prompt m
-mkFirePrompt c pos range = Prompt c SFire (FirePromptState pos) (pos, range)
-
-isCancellable :: Prompt m -> Bool
-isCancellable (Prompt Cancellable _ _ _ _)   = True
-isCancellable (Prompt Uncancellable _ _ _ _) = False
-
-submitPrompt :: Applicative m => Prompt m -> m ()
-submitPrompt (Prompt _ pt ps pri cb) =
-  case (pt, ps, pri) of
-    (SStringPrompt, StringPromptState edit, mDef) ->
-      let inputVal = mconcat . getEditContents $ edit
-          val | null inputVal, Just def <- mDef = def
-              | otherwise = inputVal
-      in cb $ StringResult val
-    (SDirectionPrompt, DirectionPromptState, _) ->
-      pure () -- Don't use submit with a direction prompt
-    (SContinue, ContinuePromptState, _) ->
-      cb ContinueResult
-    (SMenu, MenuPromptState, _) ->
-      pure () -- Don't use submit with a menu prompt
-    (SPointOnMap, PointOnMapPromptState pos, _) ->
-      cb $ PointOnMapResult pos
-    (SConfirm, ConfirmPromptState, _) ->
-      cb $ ConfirmResult True
-    (SFire, FirePromptState pos, _) ->
-      cb $ FireResult pos
diff --git a/users/grfn/xanthous/src/Xanthous/Game/State.hs b/users/grfn/xanthous/src/Xanthous/Game/State.hs
deleted file mode 100644
index 13b1ba158818..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Game/State.hs
+++ /dev/null
@@ -1,572 +0,0 @@
-{-# LANGUAGE StandaloneDeriving   #-}
-{-# LANGUAGE RecordWildCards      #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE TemplateHaskell      #-}
-{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE AllowAmbiguousTypes  #-}
---------------------------------------------------------------------------------
-module Xanthous.Game.State
-  ( GameState(..)
-  , entities
-  , levels
-  , revealedPositions
-  , messageHistory
-  , randomGen
-  , activePanel
-  , promptState
-  , characterEntityID
-  , autocommand
-  , savefile
-  , memo
-  , GamePromptState(..)
-
-    -- * Game Level
-  , GameLevel(..)
-  , levelEntities
-  , upStaircasePosition
-  , levelRevealedPositions
-
-    -- * Messages
-  , MessageHistory(..)
-  , HasMessages(..)
-  , HasTurn(..)
-  , HasDisplayedTurn(..)
-  , pushMessage
-  , previousMessage
-  , nextTurn
-
-    -- * Autocommands
-  , Autocommand(..)
-  , AutocommandState(..)
-  , _NoAutocommand
-  , _ActiveAutocommand
-
-    -- * App monad
-  , AppT(..)
-  , AppM
-  , runAppT
-
-    -- * Entities
-  , Draw(..)
-  , Brain(..)
-  , Brainless(..)
-  , brainVia
-  , Collision(..)
-  , Entity(..)
-  , SomeEntity(..)
-  , downcastEntity
-  , _SomeEntity
-  , entityIs
-  , entityTypeName
-
-    -- ** Vias
-  , Color(..)
-  , DrawNothing(..)
-  , DrawRawChar(..)
-  , DrawRawCharPriority(..)
-  , DrawCharacter(..)
-  , DrawStyledCharacter(..)
-  , DeriveEntity(..)
-    -- ** Field classes
-  , HasChar(..)
-  , HasStyle(..)
-
-    -- * Debug State
-  , DebugState(..)
-  , debugState
-  , allRevealed
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.List.NonEmpty ( NonEmpty((:|)))
-import qualified Data.List.NonEmpty as NonEmpty
-import           Data.Typeable
-import           Data.Coerce
-import           System.Random
-import           Test.QuickCheck
-import           Test.QuickCheck.Arbitrary.Generic
-import           Control.Monad.Random.Class
-import           Control.Monad.State
-import           Control.Monad.Trans.Control (MonadTransControl(..))
-import           Control.Monad.Trans.Compose
-import           Control.Monad.Morph (MFunctor(..))
-import           Brick (EventM, Widget, raw, str, emptyWidget)
-import           Data.Aeson (ToJSON(..), FromJSON(..), Value(Null))
-import qualified Data.Aeson as JSON
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Generics.Product.Fields
-import qualified Graphics.Vty.Attributes as Vty
-import qualified Graphics.Vty.Image as Vty
---------------------------------------------------------------------------------
-import           Xanthous.Util (KnownBool(..))
-import           Xanthous.Data
-import           Xanthous.Data.App
-import           Xanthous.Data.Levels
-import           Xanthous.Data.EntityMap (EntityMap, EntityID)
-import           Xanthous.Data.EntityChar
-import           Xanthous.Data.VectorBag
-import           Xanthous.Data.Entities
-import           Xanthous.Orphans ()
-import           Xanthous.Game.Prompt
-import           Xanthous.Game.Env
-import           Xanthous.Game.Memo (MemoState)
---------------------------------------------------------------------------------
-
-data MessageHistory
-  = MessageHistory
-  { _messages      :: Map Word (NonEmpty Text)
-  , _turn          :: Word
-  , _displayedTurn :: Maybe Word
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary MessageHistory
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           MessageHistory
-makeFieldsNoPrefix ''MessageHistory
-
-instance Semigroup MessageHistory where
-  (MessageHistory msgs₁ turn₁ dt₁) <> (MessageHistory msgs₂ turn₂ dt₂) =
-    MessageHistory (msgs₁ <> msgs₂) (max turn₁ turn₂) $ case (dt₁, dt₂) of
-      (_, Nothing)      -> Nothing
-      (Just t, _)       -> Just t
-      (Nothing, Just t) -> Just t
-
-instance Monoid MessageHistory where
-  mempty = MessageHistory mempty 0 Nothing
-
-type instance Element MessageHistory = [Text]
-instance MonoFunctor MessageHistory where
-  omap f mh@(MessageHistory _ t _) =
-    mh & messages . at t %~ (NonEmpty.nonEmpty . f . toList =<<)
-
-instance MonoComonad MessageHistory where
-  oextract (MessageHistory ms t dt) = maybe [] toList $ ms ^. at (fromMaybe t dt)
-  oextend cok mh@(MessageHistory _ t dt) =
-    mh & messages . at (fromMaybe t dt) .~ NonEmpty.nonEmpty (cok mh)
-
-pushMessage :: Text -> MessageHistory -> MessageHistory
-pushMessage msg mh@(MessageHistory _ turn' _) =
-  mh
-  & messages . at turn' %~ \case
-    Nothing -> Just $ msg :| mempty
-    Just msgs -> Just $ msg <| msgs
-  & displayedTurn .~ Nothing
-
-nextTurn :: MessageHistory -> MessageHistory
-nextTurn = (turn +~ 1) . (displayedTurn .~ Nothing)
-
-previousMessage :: MessageHistory -> MessageHistory
-previousMessage mh = mh & displayedTurn .~ maximumOf
-  (messages . ifolded . asIndex . filtered (< mh ^. turn))
-  mh
-
-
---------------------------------------------------------------------------------
-
-data GamePromptState m where
-  NoPrompt :: GamePromptState m
-  WaitingPrompt :: Text -> Prompt m -> GamePromptState m
-  deriving stock (Show, Generic)
-  deriving anyclass (NFData)
-
--- | Non-injective! We never try to serialize waiting prompts, since:
---
---  * they contain callback functions
---  * we can't save the game when in a prompt anyway
-instance ToJSON (GamePromptState m) where
-  toJSON _ = Null
-
--- | Always expects Null
-instance FromJSON (GamePromptState m) where
-  parseJSON Null = pure NoPrompt
-  parseJSON _ = fail "Invalid GamePromptState; expected null"
-
-instance CoArbitrary (GamePromptState m) where
-  coarbitrary NoPrompt = variant @Int 1
-  coarbitrary (WaitingPrompt txt _) = variant @Int 2 . coarbitrary txt
-
-instance Function (GamePromptState m) where
-  function = functionMap onlyNoPrompt (const NoPrompt)
-    where
-      onlyNoPrompt NoPrompt = ()
-      onlyNoPrompt (WaitingPrompt _ _) =
-        error "Can't handle prompts in Function!"
-
---------------------------------------------------------------------------------
-
-newtype AppT m a
-  = AppT { unAppT :: ReaderT GameEnv (StateT GameState m) a }
-  deriving ( Functor
-           , Applicative
-           , Monad
-           , MonadState GameState
-           , MonadReader GameEnv
-           , MonadIO
-           )
-       via (ReaderT GameEnv (StateT GameState m))
-  deriving ( MonadTrans
-           , MFunctor
-           )
-       via (ReaderT GameEnv `ComposeT` StateT GameState)
-
-type AppM = AppT (EventM ResourceName)
-
---------------------------------------------------------------------------------
-
-class Draw a where
-  drawWithNeighbors :: Neighbors (VectorBag SomeEntity) -> a -> Widget n
-  drawWithNeighbors = const draw
-
-  draw :: a -> Widget n
-  draw = drawWithNeighbors $ pure mempty
-
-  -- | higher priority gets drawn on top
-  drawPriority :: a -> Word
-  drawPriority = const minBound
-
-instance Draw a => Draw (Positioned a) where
-  drawWithNeighbors ns (Positioned _ a) = drawWithNeighbors ns a
-  draw (Positioned _ a) = draw a
-
-newtype DrawCharacter (char :: Symbol) (a :: Type) where
-  DrawCharacter :: a -> DrawCharacter char a
-
-instance KnownSymbol char => Draw (DrawCharacter char a) where
-  draw _ = str $ symbolVal @char Proxy
-
-data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White
-
-class KnownColor (color :: Color) where
-  colorVal :: forall proxy. proxy color -> Vty.Color
-
-instance KnownColor 'Black where colorVal _ = Vty.black
-instance KnownColor 'Red where colorVal _ = Vty.red
-instance KnownColor 'Green where colorVal _ = Vty.green
-instance KnownColor 'Yellow where colorVal _ = Vty.yellow
-instance KnownColor 'Blue where colorVal _ = Vty.blue
-instance KnownColor 'Magenta where colorVal _ = Vty.magenta
-instance KnownColor 'Cyan where colorVal _ = Vty.cyan
-instance KnownColor 'White where colorVal _ = Vty.white
-
-class KnownMaybeColor (maybeColor :: Maybe Color) where
-  maybeColorVal :: forall proxy. proxy maybeColor -> Maybe Vty.Color
-
-instance KnownMaybeColor 'Nothing where maybeColorVal _ = Nothing
-instance KnownColor color => KnownMaybeColor ('Just color) where
-  maybeColorVal _ = Just $ colorVal @color Proxy
-
-newtype DrawStyledCharacter (fg :: Maybe Color) (bg :: Maybe Color) (char :: Symbol) (a :: Type) where
-  DrawStyledCharacter :: a -> DrawStyledCharacter fg bg char a
-
-instance
-  ( KnownMaybeColor fg
-  , KnownMaybeColor bg
-  , KnownSymbol char
-  )
-  => Draw (DrawStyledCharacter fg bg char a) where
-  draw _ = raw $ Vty.string attr $ symbolVal @char Proxy
-    where attr = Vty.Attr
-            { Vty.attrStyle = Vty.Default
-            , Vty.attrForeColor = maybe Vty.Default Vty.SetTo
-                                  $ maybeColorVal @fg Proxy
-            , Vty.attrBackColor = maybe Vty.Default Vty.SetTo
-                                  $ maybeColorVal @bg Proxy
-            , Vty.attrURL = Vty.Default
-            }
-
-instance Draw EntityChar where
-  draw EntityChar{..} = raw $ Vty.string _style [_char]
-
---------------------------------------------------------------------------------
-
-newtype DrawNothing (a :: Type) = DrawNothing a
-
-instance Draw (DrawNothing a) where
-  draw = const emptyWidget
-  drawPriority = const 0
-
-newtype DrawRawChar (rawField :: Symbol) (a :: Type) = DrawRawChar a
-
-instance
-  forall rawField a raw.
-  ( HasField rawField a a raw raw
-  , HasChar raw EntityChar
-  ) => Draw (DrawRawChar rawField a) where
-  draw (DrawRawChar e) = draw $ e ^. field @rawField . char
-
-newtype DrawRawCharPriority
-  (rawField :: Symbol)
-  (priority :: Nat)
-  (a :: Type)
-  = DrawRawCharPriority a
-
-instance
-  forall rawField priority a raw.
-  ( HasField rawField a a raw raw
-  , KnownNat priority
-  , HasChar raw EntityChar
-  ) => Draw (DrawRawCharPriority rawField priority a) where
-  draw (DrawRawCharPriority e) = draw $ e ^. field @rawField . char
-  drawPriority = const . fromIntegral $ natVal @priority Proxy
-
-
---------------------------------------------------------------------------------
-
-class Brain a where
-  step :: Ticks -> Positioned a -> AppM (Positioned a)
-  -- | Does this entity ever move on its own?
-  entityCanMove :: a -> Bool
-  entityCanMove = const False
-
-newtype Brainless a = Brainless a
-
-instance Brain (Brainless a) where
-  step = const pure
-
--- | Workaround for the inability to use DerivingVia on Brain due to the lack of
--- higher-order roles (specifically AppT not having its last type argument have
--- role representational bc of StateT)
-brainVia
-  :: forall brain entity. (Coercible entity brain, Brain brain)
-  => (entity -> brain) -- ^ constructor, ignored
-  -> (Ticks -> Positioned entity -> AppM (Positioned entity))
-brainVia _ ticks = fmap coerce . step ticks . coerce @_ @(Positioned brain)
-
---------------------------------------------------------------------------------
-
-class ( Show a, Eq a, Ord a, NFData a
-      , ToJSON a, FromJSON a
-      , Draw a, Brain a
-      ) => Entity a where
-  entityAttributes :: a -> EntityAttributes
-  entityAttributes = const defaultEntityAttributes
-  description :: a -> Text
-  entityChar :: a -> EntityChar
-  entityCollision :: a -> Maybe Collision
-  entityCollision = const $ Just Stop
-
-data SomeEntity where
-  SomeEntity :: forall a. (Entity a, Typeable a) => a -> SomeEntity
-
-instance Show SomeEntity where
-  show (SomeEntity e) = "SomeEntity (" <> show e <> ")"
-
-instance Eq SomeEntity where
-  (SomeEntity (a :: ea)) == (SomeEntity (b :: eb)) = case eqT @ea @eb of
-    Just Refl -> a == b
-    _ -> False
-
-instance Ord SomeEntity where
-  compare (SomeEntity (a :: ea)) (SomeEntity (b :: eb)) = case eqT @ea @eb of
-    Just Refl -> compare a b
-    _ -> compare (typeRep $ Proxy @ea) (typeRep $ Proxy @eb)
-
-
-instance NFData SomeEntity where
-  rnf (SomeEntity ent) = ent `deepseq` ()
-
-instance ToJSON SomeEntity where
-  toJSON (SomeEntity ent) = entityToJSON ent
-    where
-      entityToJSON :: forall entity. (Entity entity, Typeable entity)
-                   => entity -> JSON.Value
-      entityToJSON entity = JSON.object
-        [ "type" JSON..= tshow (typeRep @_ @entity Proxy)
-        , "data" JSON..= toJSON entity
-        ]
-
-instance Draw SomeEntity where
-  drawWithNeighbors ns (SomeEntity ent) = drawWithNeighbors ns ent
-  drawPriority (SomeEntity ent) = drawPriority ent
-
-instance Brain SomeEntity where
-  step ticks (Positioned p (SomeEntity ent)) =
-    fmap SomeEntity <$> step ticks (Positioned p ent)
-  entityCanMove (SomeEntity ent) = entityCanMove ent
-
-downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a
-downcastEntity (SomeEntity e) = cast e
-
-entityIs :: forall (a :: Type). (Typeable a) => SomeEntity -> Bool
-entityIs = isJust . downcastEntity @a
-
-_SomeEntity :: forall a. (Entity a, Typeable a) => Prism' SomeEntity a
-_SomeEntity = prism' SomeEntity downcastEntity
-
--- | Get the name of the type of 'SomeEntity' as a string
-entityTypeName :: SomeEntity -> Text
-entityTypeName (SomeEntity e) = pack . tyConName . typeRepTyCon $ typeOf e
-
-newtype DeriveEntity
-  (blocksVision :: Bool)
-  (description :: Symbol)
-  (entityChar :: Symbol)
-  (entity :: Type)
-  = DeriveEntity entity
-  deriving newtype (Show, Eq, Ord, NFData, ToJSON, FromJSON, Draw)
-
-instance Brain entity => Brain (DeriveEntity b d c entity) where
-  step = brainVia $ \(DeriveEntity e) -> e
-
-instance
-  ( KnownBool blocksVision
-  , KnownSymbol description
-  , KnownSymbol entityChar
-  , Show entity, Eq entity, Ord entity, NFData entity
-  , ToJSON entity, FromJSON entity
-  , Draw entity, Brain entity
-  )
-  => Entity (DeriveEntity blocksVision description entityChar entity) where
-  entityAttributes _ = defaultEntityAttributes
-    & blocksVision .~ boolVal @blocksVision
-  description _ = pack . symbolVal $ Proxy @description
-  entityChar _ = fromString . symbolVal $ Proxy @entityChar
-
---------------------------------------------------------------------------------
-
-data GameLevel = GameLevel
-  { _levelEntities :: !(EntityMap SomeEntity)
-  , _upStaircasePosition :: !Position
-  , _levelRevealedPositions :: !(Set Position)
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-  deriving (ToJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           GameLevel
-
---------------------------------------------------------------------------------
-
-data Autocommand
-  = AutoMove Direction
-  | AutoRest
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, Hashable, ToJSON, FromJSON, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Autocommand
-{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
-
-data AutocommandState
-  = NoAutocommand
-  | ActiveAutocommand Autocommand (Async ())
-  deriving stock (Eq, Ord, Generic)
-  deriving anyclass (Hashable)
-
-instance Show AutocommandState where
-  show NoAutocommand = "NoAutocommand"
-  show (ActiveAutocommand ac _) =
-    "(ActiveAutocommand " <> show ac <> " <Async>)"
-
-instance ToJSON AutocommandState where
-  toJSON = const Null
-
-instance FromJSON AutocommandState where
-  parseJSON Null = pure NoAutocommand
-  parseJSON _ = fail "Invalid AutocommandState; expected null"
-
-instance NFData AutocommandState where
-  rnf NoAutocommand = ()
-  rnf (ActiveAutocommand ac t) = ac `deepseq` t `seq` ()
-
-instance CoArbitrary AutocommandState where
-  coarbitrary NoAutocommand = variant @Int 1
-  coarbitrary (ActiveAutocommand ac t)
-    = variant @Int 2
-    . coarbitrary ac
-    . coarbitrary (hash t)
-
-instance Function AutocommandState where
-  function = functionMap onlyNoAC (const NoAutocommand)
-    where
-      onlyNoAC NoAutocommand = ()
-      onlyNoAC _ = error "Can't handle autocommands in Function"
-
---------------------------------------------------------------------------------
-
-
-data DebugState = DebugState
-  { _allRevealed :: !Bool
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           DebugState
-{-# ANN DebugState ("HLint: ignore Use newtype instead of data" :: String) #-}
-
-instance Arbitrary DebugState where
-  arbitrary = genericArbitrary
-
-data GameState = GameState
-  { _levels            :: !(Levels GameLevel)
-  , _characterEntityID :: !EntityID
-  , _messageHistory    :: !MessageHistory
-  , _randomGen         :: !StdGen
-
-    -- | The active panel displayed in the UI, if any
-  , _activePanel       :: !(Maybe Panel)
-
-  , _promptState       :: !(GamePromptState AppM)
-  , _debugState        :: !DebugState
-  , _autocommand       :: !AutocommandState
-
-  -- | The path to the savefile that was loaded for this game, if any
-  , _savefile          :: !(Maybe FilePath)
-
-  , _memo              :: MemoState
-  }
-  deriving stock (Show, Generic)
-  deriving anyclass (NFData)
-  deriving (ToJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           GameState
-
-makeLenses ''GameLevel
-makeLenses ''GameState
-
-entities :: Lens' GameState (EntityMap SomeEntity)
-entities = levels . current . levelEntities
-
-revealedPositions :: Lens' GameState (Set Position)
-revealedPositions = levels . current . levelRevealedPositions
-
-instance Eq GameState where
-  (==) = (==) `on` \gs ->
-    ( gs ^. entities
-    , gs ^. revealedPositions
-    , gs ^. characterEntityID
-    , gs ^. messageHistory
-    , gs ^. activePanel
-    , gs ^. debugState
-    )
-
---------------------------------------------------------------------------------
-
-runAppT :: Monad m => AppT m a -> GameEnv -> GameState -> m (a, GameState)
-runAppT appt env initialState
-  = flip runStateT initialState
-  . flip runReaderT env
-  . unAppT
-  $ appt
-
-instance (Monad m) => MonadRandom (AppT m) where
-  getRandomR rng = randomGen %%= randomR rng
-  getRandom = randomGen %%= random
-  getRandomRs rng = uses randomGen $ randomRs rng
-  getRandoms = uses randomGen randoms
-
-instance MonadTransControl AppT where
-  type StT AppT a = (a, GameState)
-  liftWith f
-    = AppT
-    . ReaderT $ \e
-    -> StateT $ \s
-    -> (,s) <$> f (\action -> runAppT action e s)
-  restoreT = AppT . ReaderT . const . StateT . const
-
---------------------------------------------------------------------------------
-
-makeLenses ''DebugState
-makePrisms ''AutocommandState
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level.hs
deleted file mode 100644
index fc57402e7d8e..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level.hs
+++ /dev/null
@@ -1,172 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE GADTs           #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level
-  ( generate
-  , Generator(..)
-  , SGenerator(..)
-  , GeneratorInput(..)
-  , generateFromInput
-  , parseGeneratorInput
-  , showCells
-  , Level(..)
-  , levelWalls
-  , levelItems
-  , levelCreatures
-  , levelDoors
-  , levelCharacterPosition
-  , levelTutorialMessage
-  , levelExtra
-  , generateLevel
-  , levelToEntityMap
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Data.Array.Unboxed
-import qualified Options.Applicative as Opt
-import           Control.Monad.Random
---------------------------------------------------------------------------------
-import qualified Xanthous.Generators.Level.CaveAutomata as CaveAutomata
-import qualified Xanthous.Generators.Level.Dungeon as Dungeon
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Generators.Level.LevelContents
-import           Xanthous.Generators.Level.Village as Village
-import           Xanthous.Data (Dimensions, Position'(Position), Position)
-import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Environment
-import           Xanthous.Entities.Item (Item)
-import           Xanthous.Entities.Creature (Creature)
-import           Xanthous.Game.State (SomeEntity(..))
-import           Linear.V2
---------------------------------------------------------------------------------
-
-data Generator
-  = CaveAutomata
-  | Dungeon
-  deriving stock (Show, Eq)
-
-data SGenerator (gen :: Generator) where
-  SCaveAutomata :: SGenerator 'CaveAutomata
-  SDungeon :: SGenerator 'Dungeon
-
-type family Params (gen :: Generator) :: Type where
-  Params 'CaveAutomata = CaveAutomata.Params
-  Params 'Dungeon = Dungeon.Params
-
-generate
-  :: RandomGen g
-  => SGenerator gen
-  -> Params gen
-  -> Dimensions
-  -> g
-  -> Cells
-generate SCaveAutomata = CaveAutomata.generate
-generate SDungeon = Dungeon.generate
-
-data GeneratorInput where
-  GeneratorInput :: forall gen. SGenerator gen -> Params gen -> GeneratorInput
-
-generateFromInput :: RandomGen g => GeneratorInput -> Dimensions -> g -> Cells
-generateFromInput (GeneratorInput sg ps) = generate sg ps
-
-parseGeneratorInput :: Opt.Parser GeneratorInput
-parseGeneratorInput = Opt.subparser
-  $ generatorCommand SCaveAutomata
-      "cave"
-      "Cellular-automata based cave generator"
-      CaveAutomata.parseParams
-  <> generatorCommand SDungeon
-      "dungeon"
-      "Classic dungeon map generator"
-      Dungeon.parseParams
-  where
-    generatorCommand sgen name desc parseParams =
-      Opt.command name
-        (Opt.info
-          (GeneratorInput sgen <$> parseParams)
-          (Opt.progDesc desc)
-        )
-
-
-showCells :: Cells -> Text
-showCells arr =
-  let (V2 minX minY, V2 maxX maxY) = bounds arr
-      showCellVal True = "x"
-      showCellVal False = " "
-      showCell = showCellVal . (arr !)
-      row r = foldMap (showCell . (`V2` r)) [minX..maxX]
-      rows = row <$> [minY..maxY]
-  in intercalate "\n" rows
-
-cellsToWalls :: Cells -> EntityMap Wall
-cellsToWalls cells = foldl' maybeInsertWall mempty . assocs $ cells
-  where
-    maybeInsertWall em (pos@(V2 x y), True)
-      | not (surroundedOnAllSides pos) =
-        let x' = fromIntegral x
-            y' = fromIntegral y
-        in EntityMap.insertAt (Position x' y') Wall em
-    maybeInsertWall em _ = em
-    surroundedOnAllSides pos = numAliveNeighbors cells pos == 8
-
---------------------------------------------------------------------------------
-
-data Level = Level
-  { _levelWalls             :: !(EntityMap Wall)
-  , _levelDoors             :: !(EntityMap Door)
-  , _levelItems             :: !(EntityMap Item)
-  , _levelCreatures         :: !(EntityMap Creature)
-  , _levelTutorialMessage   :: !(EntityMap GroundMessage)
-  , _levelStaircases        :: !(EntityMap Staircase)
-  , _levelExtra             :: !(EntityMap SomeEntity) -- ^ TODO this is a bit of a hack...
-  , _levelCharacterPosition :: !Position
-  }
-  deriving stock (Generic)
-  deriving anyclass (NFData)
-makeLenses ''Level
-
-generateLevel
-  :: MonadRandom m
-  => SGenerator gen
-  -> Params gen
-  -> Dimensions
-  -> Word -- ^ Level number, starting at 0
-  -> m Level
-generateLevel gen ps dims num = do
-  rand <- mkStdGen <$> getRandom
-  let cells = generate gen ps dims rand
-      _levelWalls = cellsToWalls cells
-  village <- generateVillage cells gen
-  let _levelExtra = village
-  _levelItems <- randomItems cells
-  _levelCreatures <- randomCreatures num cells
-  _levelDoors <- randomDoors cells
-  _levelCharacterPosition <- chooseCharacterPosition cells
-  let upStaircase = _EntityMap # [(_levelCharacterPosition, UpStaircase)]
-  downStaircase <- placeDownStaircase cells
-  let _levelStaircases = upStaircase <> downStaircase
-  _levelTutorialMessage <-
-    if num == 0
-    then tutorialMessage cells _levelCharacterPosition
-    else pure mempty
-  pure Level {..}
-
-levelToEntityMap :: Level -> EntityMap SomeEntity
-levelToEntityMap level
-  = (SomeEntity <$> level ^. levelWalls)
-  <> (SomeEntity <$> level ^. levelDoors)
-  <> (SomeEntity <$> level ^. levelItems)
-  <> (SomeEntity <$> level ^. levelCreatures)
-  <> (SomeEntity <$> level ^. levelTutorialMessage)
-  <> (SomeEntity <$> level ^. levelStaircases)
-  <> (level ^. levelExtra)
-
-generateVillage
-  :: MonadRandom m
-  => Cells -- ^ Wall positions
-  -> SGenerator gen
-  -> m (EntityMap SomeEntity)
-generateVillage wallPositions SCaveAutomata = Village.fromCave wallPositions
-generateVillage _ _ = pure mempty
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs
deleted file mode 100644
index 03d534ca39b3..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/CaveAutomata.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.CaveAutomata
-  ( Params(..)
-  , defaultParams
-  , parseParams
-  , generate
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Control.Monad.Random (RandomGen, runRandT)
-import           Data.Array.ST
-import           Data.Array.Unboxed
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-import           Xanthous.Util (between)
-import           Xanthous.Util.Optparse
-import           Xanthous.Data (Dimensions, width, height)
-import           Xanthous.Generators.Level.Util
-import           Linear.V2
---------------------------------------------------------------------------------
-
-data Params = Params
-  { _aliveStartChance :: Double
-  , _birthLimit :: Word
-  , _deathLimit :: Word
-  , _steps :: Word
-  }
-  deriving stock (Show, Eq, Generic)
-makeLenses ''Params
-
-defaultParams :: Params
-defaultParams = Params
-  { _aliveStartChance = 0.6
-  , _birthLimit = 3
-  , _deathLimit = 4
-  , _steps = 4
-  }
-
-parseParams :: Opt.Parser Params
-parseParams = Params
-  <$> Opt.option parseChance
-      ( Opt.long "alive-start-chance"
-      <> Opt.value (defaultParams ^. aliveStartChance)
-      <> Opt.showDefault
-      <> Opt.help ( "Chance for each cell to start alive at the beginning of "
-                 <> "the cellular automata"
-                 )
-      <> Opt.metavar "CHANCE"
-      )
-  <*> Opt.option parseNeighbors
-      ( Opt.long "birth-limit"
-      <> Opt.value (defaultParams ^. birthLimit)
-      <> Opt.showDefault
-      <> Opt.help "Minimum neighbor count required for birth of a cell"
-      <> Opt.metavar "NEIGHBORS"
-      )
-  <*> Opt.option parseNeighbors
-      ( Opt.long "death-limit"
-      <> Opt.value (defaultParams ^. deathLimit)
-      <> Opt.showDefault
-      <> Opt.help "Maximum neighbor count required for death of a cell"
-      <> Opt.metavar "NEIGHBORS"
-      )
-  <*> Opt.option Opt.auto
-      ( Opt.long "steps"
-      <> Opt.value (defaultParams ^. steps)
-      <> Opt.showDefault
-      <> Opt.help "Number of generations to run the automata for"
-      <> Opt.metavar "STEPS"
-      )
-  <**> Opt.helper
-  where
-    parseChance = readWithGuard
-      (between 0 1)
-      $ \res -> "Chance must be in the range [0,1], got: " <> show res
-
-    parseNeighbors = readWithGuard
-      (between 0 8)
-      $ \res -> "Neighbors must be in the range [0,8], got: " <> show res
-
-generate :: RandomGen g => Params -> Dimensions -> g -> Cells
-generate params dims gen
-  = runSTUArray
-  $ fmap fst
-  $ flip runRandT gen
-  $ generate' params dims
-
-generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s)
-generate' params dims = do
-  cells <- randInitialize dims $ params ^. aliveStartChance
-  let steps' = params ^. steps
-  when (steps' > 0)
-   $ for_ [0 .. pred steps'] . const $ stepAutomata cells dims params
-  -- Remove all but the largest contiguous region of unfilled space
-  (_: smallerRegions) <- lift $ regions @UArray . amap not <$> freeze cells
-  lift $ fillAllM (fold smallerRegions) cells
-  lift $ fillOuterEdgesM cells
-  pure cells
-
-stepAutomata :: forall s g. MCells s -> Dimensions -> Params -> CellM g s ()
-stepAutomata cells dims params = do
-  origCells <- lift $ cloneMArray @_ @(STUArray s) cells
-  for_ (range (0, V2 (dims ^. width) (dims ^. height))) $ \pos -> do
-    neighs <- lift $ numAliveNeighborsM origCells pos
-    origValue <- lift $ readArray origCells pos
-    lift . writeArray cells pos
-      $ if origValue
-        then neighs >= params ^. deathLimit
-        else neighs > params ^. birthLimit
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs
deleted file mode 100644
index 0be7c0435c5a..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Dungeon.hs
+++ /dev/null
@@ -1,190 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Dungeon
-  ( Params(..)
-  , defaultParams
-  , parseParams
-  , generate
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((:>))
---------------------------------------------------------------------------------
-import           Control.Monad.Random
-import           Data.Array.ST
-import           Data.Array.IArray (amap)
-import           Data.Stream.Infinite (Stream(..))
-import qualified Data.Stream.Infinite as Stream
-import qualified Data.Graph.Inductive.Graph as Graph
-import           Data.Graph.Inductive.PatriciaTree
-import qualified Data.List.NonEmpty as NE
-import           Data.Maybe (fromJust)
-import           Linear.V2
-import           Linear.Metric
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-import           Xanthous.Random
-import           Xanthous.Data hiding (x, y, _x, _y, edges, distance)
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Util.Graphics (delaunay, straightLine)
-import           Xanthous.Util.Graph (mstSubGraph)
---------------------------------------------------------------------------------
-
-data Params = Params
-  { _numRoomsRange :: (Word, Word)
-  , _roomDimensionRange :: (Word, Word)
-  , _connectednessRatioRange :: (Double, Double)
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-makeLenses ''Params
-
-defaultParams :: Params
-defaultParams = Params
-  { _numRoomsRange = (6, 8)
-  , _roomDimensionRange = (3, 12)
-  , _connectednessRatioRange = (0.1, 0.15)
-  }
-
-parseParams :: Opt.Parser Params
-parseParams = Params
-  <$> parseRange
-        "num-rooms"
-        "number of rooms to generate in the dungeon"
-        "ROOMS"
-        (defaultParams ^. numRoomsRange)
-  <*> parseRange
-        "room-size"
-        "size in tiles of one of the sides of a room"
-        "TILES"
-        (defaultParams ^. roomDimensionRange)
-  <*> parseRange
-        "connectedness-ratio"
-        ( "ratio of edges from the delaunay triangulation to re-add to the "
-        <> "minimum-spanning-tree")
-        "RATIO"
-        (defaultParams ^. connectednessRatioRange)
-  <**> Opt.helper
-  where
-    parseRange name desc metavar (defMin, defMax) =
-      (,)
-      <$> Opt.option Opt.auto
-          ( Opt.long ("min-" <> name)
-          <> Opt.value defMin
-          <> Opt.showDefault
-          <> Opt.help ("Minimum " <> desc)
-          <> Opt.metavar metavar
-          )
-      <*> Opt.option Opt.auto
-          ( Opt.long ("max-" <> name)
-          <> Opt.value defMax
-          <> Opt.showDefault
-          <> Opt.help ("Maximum " <> desc)
-          <> Opt.metavar metavar
-          )
-
-generate :: RandomGen g => Params -> Dimensions -> g -> Cells
-generate params dims gen
-  = amap not
-  $ runSTUArray
-  $ fmap fst
-  $ flip runRandT gen
-  $ generate' params dims
-
---------------------------------------------------------------------------------
-
-generate' :: RandomGen g => Params -> Dimensions -> CellM g s (MCells s)
-generate' params dims = do
-  cells <- initializeEmpty dims
-  rooms <- genRooms params dims
-  for_ rooms $ fillRoom cells
-
-  let fullRoomGraph = delaunayRoomGraph rooms
-      mst = mstSubGraph fullRoomGraph
-      mstEdges = Graph.edges mst
-      nonMSTEdges = filter (\(n₁, n₂, _) -> (n₁, n₂) `notElem` mstEdges)
-                    $ Graph.labEdges fullRoomGraph
-
-  reintroEdgeCount <- floor . (* fromIntegral (length nonMSTEdges))
-                     <$> getRandomR (params ^. connectednessRatioRange)
-  let reintroEdges = take reintroEdgeCount nonMSTEdges
-      corridorGraph = Graph.insEdges reintroEdges mst
-
-  corridors <- traverse
-              ( uncurry corridorBetween
-              . over both (fromJust . Graph.lab corridorGraph)
-              ) $ Graph.edges corridorGraph
-
-  for_ (join corridors) $ \pt -> lift $ writeArray cells pt True
-
-  pure cells
-
-type Room = Box Word
-
-genRooms :: MonadRandom m => Params -> Dimensions -> m [Room]
-genRooms params dims = do
-  numRooms <- fromIntegral <$> getRandomR (params ^. numRoomsRange)
-  subRand . fmap (Stream.take numRooms . removeIntersecting []) . infinitely $ do
-    roomWidth <- getRandomR $ params ^. roomDimensionRange
-    roomHeight <- getRandomR $ params ^. roomDimensionRange
-    xPos <- getRandomR (0, dims ^. width - roomWidth)
-    yPos <- getRandomR (0, dims ^. height - roomHeight)
-    pure Box
-      { _topLeftCorner = V2 xPos yPos
-      , _dimensions = V2 roomWidth roomHeight
-      }
-  where
-    removeIntersecting seen (room :> rooms)
-      | any (boxIntersects room) seen
-      = removeIntersecting seen rooms
-      | otherwise
-      = room :> removeIntersecting (room : seen) rooms
-    streamRepeat x = x :> streamRepeat x
-    infinitely = sequence . streamRepeat
-
-delaunayRoomGraph :: [Room] -> Gr Room Double
-delaunayRoomGraph rooms =
-  Graph.insEdges edges . Graph.insNodes nodes $ Graph.empty
-  where
-    edges = map (\((n₁, room₁), (n₂, room₂)) -> (n₁, n₂, roomDist room₁ room₂))
-          . over (mapped . both) snd
-          . delaunay @Double
-          . NE.fromList
-          . map (\p@(_, room) -> (boxCenter $ fromIntegral <$> room, p))
-          $ nodes
-    nodes = zip [0..] rooms
-    roomDist = distance `on` (boxCenter . fmap fromIntegral)
-
-fillRoom :: MCells s -> Room -> CellM g s ()
-fillRoom cells room =
-  let V2 posx posy = room ^. topLeftCorner
-      V2 dimx dimy = room ^. dimensions
-  in for_ [posx .. posx + dimx] $ \x ->
-       for_ [posy .. posy + dimy] $ \y ->
-         lift $ writeArray cells (V2 x y) True
-
-corridorBetween :: MonadRandom m => Room -> Room -> m [V2 Word]
-corridorBetween originRoom destinationRoom
-  = straightLine <$> origin <*> destination
-  where
-    origin = choose . NE.fromList =<< originEdge
-    destination = choose . NE.fromList =<< destinationEdge
-    originEdge = pickEdge originRoom originCorner
-    destinationEdge = pickEdge destinationRoom destinationCorner
-    pickEdge room corner = choose . over both (boxEdge room) $ cornerEdges corner
-    originCorner =
-      case ( compare (originRoom ^. topLeftCorner . _x)
-                     (destinationRoom ^. topLeftCorner . _x)
-           , compare (originRoom ^. topLeftCorner . _y)
-                     (destinationRoom ^. topLeftCorner . _y)
-           ) of
-        (LT, LT) -> BottomRight
-        (LT, GT) -> TopRight
-        (GT, LT) -> BottomLeft
-        (GT, GT) -> TopLeft
-
-        (EQ, LT) -> BottomLeft
-        (EQ, GT) -> TopRight
-        (GT, EQ) -> TopLeft
-        (LT, EQ) -> BottomRight
-        (EQ, EQ) -> TopLeft -- should never happen
-
-    destinationCorner = opposite originCorner
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
deleted file mode 100644
index 4f8a2f42ee16..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/LevelContents.hs
+++ /dev/null
@@ -1,182 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.LevelContents
-  ( chooseCharacterPosition
-  , randomItems
-  , randomCreatures
-  , randomDoors
-  , placeDownStaircase
-  , tutorialMessage
-  , entityFromRaw
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (any, toList)
---------------------------------------------------------------------------------
-import           Control.Monad.Random
-import           Data.Array.IArray (amap, bounds, rangeSize, (!))
-import qualified Data.Array.IArray as Arr
-import           Data.Foldable (any, toList)
-import           Linear.V2
---------------------------------------------------------------------------------
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Random hiding (chance)
-import qualified Xanthous.Random as Random
-import           Xanthous.Data
-                 ( positionFromV2,  Position, _Position
-                 , rotations, arrayNeighbors, Neighbors(..)
-                 , neighborPositions
-                 )
-import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
-import           Xanthous.Entities.Raws (rawsWithType, RawType, raw)
-import qualified Xanthous.Entities.Item as Item
-import           Xanthous.Entities.Item (Item)
-import qualified Xanthous.Entities.Creature as Creature
-import           Xanthous.Entities.Creature (Creature)
-import           Xanthous.Entities.Environment
-                 (GroundMessage(..), Door(..), unlockedDoor, Staircase(..))
-import           Xanthous.Messages (message_)
-import           Xanthous.Util.Graphics (circle)
-import           Xanthous.Entities.RawTypes
-import           Xanthous.Entities.Creature.Hippocampus (initialHippocampus)
-import           Xanthous.Entities.Common (inRightHand, asWieldedItem, wielded)
-import           Xanthous.Game.State (SomeEntity(SomeEntity))
---------------------------------------------------------------------------------
-
-chooseCharacterPosition :: MonadRandom m => Cells -> m Position
-chooseCharacterPosition = randomPosition
-
-randomItems :: MonadRandom m => Cells -> m (EntityMap Item)
-randomItems = randomEntities (fmap Identity . Item.newWithType) (0.0004, 0.001)
-
-placeDownStaircase :: MonadRandom m => Cells -> m (EntityMap Staircase)
-placeDownStaircase cells = do
-  pos <- randomPosition cells
-  pure $ _EntityMap # [(pos, DownStaircase)]
-
-randomDoors :: MonadRandom m => Cells -> m (EntityMap Door)
-randomDoors cells = do
-  doorRatio <- getRandomR subsetRange
-  let numDoors = floor $ doorRatio * fromIntegral (length candidateCells)
-      doorPositions =
-        removeAdjacent . fmap positionFromV2 . take numDoors $ candidateCells
-      doors = zip doorPositions $ repeat unlockedDoor
-  pure $ _EntityMap # doors
-  where
-    removeAdjacent =
-      foldr (\pos acc ->
-               if pos `elem` (acc >>= toList . neighborPositions)
-               then acc
-               else pos : acc
-            ) []
-    candidateCells = filter doorable $ Arr.indices cells
-    subsetRange = (0.8 :: Double, 1.0)
-    doorable pos =
-      not (fromMaybe True $ cells ^? ix pos)
-      && any (teeish . fmap (fromMaybe True))
-        (rotations $ arrayNeighbors cells pos)
-    -- only generate doors at the *ends* of hallways, eg (where O is walkable,
-    -- X is a wall, and D is a door):
-    --
-    -- O O O
-    -- X D X
-    --   O
-    teeish (fmap not -> (Neighbors tl t tr l r _ b _ )) =
-      and [tl, t, tr, b] && (and . fmap not) [l, r]
-
-randomCreatures
-  :: MonadRandom m
-  => Word -- ^ Level number, starting at 0
-  -> Cells
-  -> m (EntityMap Creature)
-randomCreatures levelNumber
-  = randomEntities maybeNewCreature (0.0007, 0.002)
-  where
-    maybeNewCreature cType
-      | maybe True (canGenerate levelNumber) $ cType ^. generateParams
-      = Just <$> newCreatureWithType cType
-      | otherwise
-      = pure Nothing
-
-newCreatureWithType :: MonadRandom m => CreatureType -> m Creature
-newCreatureWithType _creatureType = do
-  let _hitpoints = _creatureType ^. maxHitpoints
-      _hippocampus = initialHippocampus
-
-  equipped <- fmap join
-            . traverse genEquipped
-            $ _creatureType
-            ^.. generateParams . _Just . equippedItem . _Just
-  let _inventory = maybe id (\ei -> wielded .~ inRightHand ei) (headMay equipped) mempty
-  pure Creature.Creature {..}
-  where
-    genEquipped cei = do
-      doGen <- Random.chance $ cei ^. chance
-      let entName = cei ^. entityName
-          itemType =
-            fromMaybe (error $ "raw \"" <> unpack entName <> "\" not of type Item")
-            . preview _Item
-            . fromMaybe (error $ "Could not find raw: " <> unpack entName)
-            $ raw entName
-      item <- Item.newWithType itemType
-      if doGen
-        then pure [fromMaybe (error $ "raw \"" <> unpack entName <> "\" not wieldable")
-                  $ preview asWieldedItem item]
-        else pure []
-
-
-tutorialMessage :: MonadRandom m
-  => Cells
-  -> Position -- ^ CharacterPosition
-  -> m (EntityMap GroundMessage)
-tutorialMessage cells characterPosition = do
-  let distance = 2
-  pos <- fmap (fromMaybe (error "No valid positions for tutorial message?"))
-        . choose . ChooseElement
-        $ accessiblePositionsWithin distance cells characterPosition
-  msg <- message_ ["tutorial", "message1"]
-  pure $ _EntityMap # [(pos, GroundMessage msg)]
-  where
-    accessiblePositionsWithin :: Int -> Cells -> Position -> [Position]
-    accessiblePositionsWithin dist valid pos =
-      review _Position
-      <$> filter
-            (\pt -> not $ valid ! (fromIntegral <$> pt))
-            (circle (pos ^. _Position) dist)
-
-randomEntities
-  :: forall entity raw m t. (MonadRandom m, RawType raw, Functor t, Foldable t)
-  => (raw -> m (t entity))
-  -> (Float, Float)
-  -> Cells
-  -> m (EntityMap entity)
-randomEntities newWithType sizeRange cells =
-  case fromNullable $ rawsWithType @raw of
-    Nothing -> pure mempty
-    Just raws -> do
-      let len = rangeSize $ bounds cells
-      (numEntities :: Int) <-
-        floor . (* fromIntegral len) <$> getRandomR sizeRange
-      entities <- for [0..numEntities] $ const $ do
-        pos <- randomPosition cells
-        r <- choose raws
-        entities <- newWithType r
-        pure $ (pos, ) <$> entities
-      pure $ _EntityMap # (entities >>= toList)
-
-randomPosition :: MonadRandom m => Cells -> m Position
-randomPosition = fmap positionFromV2 . choose . impureNonNull . cellCandidates
-
--- cellCandidates :: Cells -> Cells
-cellCandidates :: Cells -> Set (V2 Word)
-cellCandidates
-  -- find the largest contiguous region of cells in the cave.
-  = maximumBy (compare `on` length)
-  . fromMaybe (error "No regions generated! this should never happen.")
-  . fromNullable
-  . regions
-  -- cells ends up with true = wall, we want true = can put an item here
-  . amap not
-
-entityFromRaw :: MonadRandom m => EntityRaw -> m SomeEntity
-entityFromRaw (Creature ct) = SomeEntity <$> newCreatureWithType ct
-entityFromRaw (Item it) = SomeEntity <$> Item.newWithType it
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
deleted file mode 100644
index 0008eb965c42..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Util.hs
+++ /dev/null
@@ -1,236 +0,0 @@
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE AllowAmbiguousTypes #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Util
-  ( MCells
-  , Cells
-  , CellM
-  , randInitialize
-  , initializeEmpty
-  , numAliveNeighborsM
-  , numAliveNeighbors
-  , fillOuterEdgesM
-  , cloneMArray
-  , floodFill
-  , regions
-  , fillAll
-  , fillAllM
-  , fromPoints
-  , fromPointsM
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (Foldable, toList, for_)
---------------------------------------------------------------------------------
-import           Data.Array.ST
-import           Data.Array.Unboxed
-import           Control.Monad.ST
-import           Control.Monad.Random
-import           Data.Monoid
-import           Data.Foldable (Foldable, toList, for_)
-import qualified Data.Set as Set
-import           Data.Semigroup.Foldable
-import           Linear.V2
---------------------------------------------------------------------------------
-import           Xanthous.Util (foldlMapM', maximum1, minimum1)
-import           Xanthous.Data (Dimensions, width, height)
---------------------------------------------------------------------------------
-
-type MCells s = STUArray s (V2 Word) Bool
-type Cells = UArray (V2 Word) Bool
-type CellM g s a = RandT g (ST s) a
-
-randInitialize :: RandomGen g => Dimensions -> Double -> CellM g s (MCells s)
-randInitialize dims aliveChance = do
-  res <- initializeEmpty dims
-  for_ [0..dims ^. width] $ \i ->
-    for_ [0..dims ^. height] $ \j -> do
-      val <- (>= aliveChance) <$> getRandomR (0, 1)
-      lift $ writeArray res (V2 i j) val
-  pure res
-
-initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
-initializeEmpty dims =
-  lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False
-
--- | Returns the number of neighbors of the given point in the given array that
--- are True.
---
--- Behavior if point is out-of-bounds for the array is undefined, but will not
--- error
-numAliveNeighborsM
-  :: forall a i m
-  . (MArray a Bool m, Ix i, Integral i)
-  => a (V2 i) Bool
-  -> V2 i
-  -> m Word
-numAliveNeighborsM cells pt@(V2 x y) = do
-  cellBounds <- getBounds cells
-  getSum <$> foldlMapM'
-    (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
-    neighborPositions
-
-  where
-    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool
-    boundedGet bnds _
-      | not (inRange bnds pt)
-      = pure True
-    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | (x <= minX && i < 0)
-      || (y <= minY && j < 0)
-      || (x >= maxX && i > 0)
-      || (y >= maxY && j > 0)
-      = pure True
-      | otherwise =
-        let nx = fromIntegral $ fromIntegral x + i
-            ny = fromIntegral $ fromIntegral y + j
-        in readArray cells $ V2 nx ny
-
--- | Returns the number of neighbors of the given point in the given array that
--- are True.
---
--- Behavior if point is out-of-bounds for the array is undefined, but will not
--- error
-numAliveNeighbors
-  :: forall a i
-  . (IArray a Bool, Ix i, Integral i)
-  => a (V2 i) Bool
-  -> V2 i
-  -> Word
-numAliveNeighbors cells pt@(V2 x y) =
-  let cellBounds = bounds cells
-  in getSum $ foldMap
-      (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
-      neighborPositions
-
-  where
-    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
-    boundedGet bnds _
-      | not (inRange bnds pt)
-      = True
-    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
-      | (x <= minX && i < 0)
-      || (y <= minY && j < 0)
-      || (x >= maxX && i > 0)
-      || (y >= maxY && j > 0)
-      = True
-      | otherwise =
-        let nx = fromIntegral $ fromIntegral x + i
-            ny = fromIntegral $ fromIntegral y + j
-        in cells ! V2 nx ny
-
-neighborPositions :: [(Int, Int)]
-neighborPositions = [(i, j) | i <- [-1..1], j <- [-1..1], (i, j) /= (0, 0)]
-
-fillOuterEdgesM :: (MArray a Bool m, Ix i) => a (V2 i) Bool -> m ()
-fillOuterEdgesM arr = do
-  (V2 minX minY, V2 maxX maxY) <- getBounds arr
-  for_ (range (minX, maxX)) $ \x -> do
-    writeArray arr (V2 x minY) True
-    writeArray arr (V2 x maxY) True
-  for_ (range (minY, maxY)) $ \y -> do
-    writeArray arr (V2 minX y) True
-    writeArray arr (V2 maxX y) True
-
-cloneMArray
-  :: forall a a' i e m.
-  ( Ix i
-  , MArray a e m
-  , MArray a' e m
-  , IArray UArray e
-  )
-  => a i e
-  -> m (a' i e)
-cloneMArray = thaw @_ @UArray <=< freeze
-
---------------------------------------------------------------------------------
-
--- | Flood fill a cell array starting at a point, returning a list of all the
--- (true) cell locations reachable from that point
-floodFill :: forall a i.
-            ( IArray a Bool
-            , Ix i
-            , Enum i
-            , Bounded i
-            , Eq i
-            )
-          => a (V2 i) Bool -- ^ array
-          -> (V2 i)        -- ^ position
-          -> Set (V2 i)
-floodFill = go mempty
-  where
-    go :: Set (V2 i) -> a (V2 i) Bool -> (V2 i) -> Set (V2 i)
-    go res arr@(bounds -> arrBounds) idx@(V2 x y)
-      | not (inRange arrBounds idx) =  res
-      | not (arr ! idx) =  res
-      | otherwise =
-        let neighbors
-              = filter (inRange arrBounds)
-              . filter (/= idx)
-              . filter (`notMember` res)
-              $ V2
-              <$> [(if x == minBound then x else pred x)
-                   ..
-                   (if x == maxBound then x else succ x)]
-              <*> [(if y == minBound then y else pred y)
-                   ..
-                   (if y == maxBound then y else succ y)]
-        in foldl' (\r idx' ->
-                     if arr ! idx'
-                     then r <> (let r' = r & contains idx' .~ True
-                               in r' `seq` go r' arr idx')
-                     else r)
-           (res & contains idx .~ True) neighbors
-{-# SPECIALIZE floodFill :: UArray (V2 Word) Bool -> (V2 Word) -> Set (V2 Word) #-}
-
--- | Gives a list of all the disconnected regions in a cell array, represented
--- each as lists of points
-regions :: forall a i.
-          ( IArray a Bool
-          , Ix i
-          , Enum i
-          , Bounded i
-          , Eq i
-          )
-        => a (V2 i) Bool
-        -> [Set (V2 i)]
-regions arr
-  | Just firstPoint <- findFirstPoint arr =
-      let region = floodFill arr firstPoint
-          arr' = fillAll region arr
-      in region : regions arr'
-  | otherwise = []
-  where
-    findFirstPoint :: a (V2 i) Bool -> Maybe (V2 i)
-    findFirstPoint = fmap fst . headMay . filter snd . assocs
-{-# SPECIALIZE regions :: UArray (V2 Word) Bool -> [Set (V2 Word)] #-}
-
-fillAll :: (IArray a Bool, Ix i, Foldable f) => f i -> a i Bool -> a i Bool
-fillAll ixes a = accum (const fst) a $ (, (False, ())) <$> toList ixes
-
-fillAllM :: (MArray a Bool m, Ix i, Foldable f) => f i -> a i Bool -> m ()
-fillAllM ixes a = for_ ixes $ \i -> writeArray a i False
-
-fromPoints
-  :: forall a f i.
-    ( IArray a Bool
-    , Ix i
-    , Functor f
-    , Foldable1 f
-    )
-  => f (i, i)
-  -> a (i, i) Bool
-fromPoints points =
-  let pts = Set.fromList $ toList points
-      dims = ( (minimum1 $ fst <$> points, minimum1 $ snd <$> points)
-             , (maximum1 $ fst <$> points, maximum1 $ snd <$> points)
-             )
-  in array dims $ range dims <&> \i -> (i, i `member` pts)
-
-fromPointsM
-  :: (MArray a Bool m, Ix i, Element f ~ i, MonoFoldable f)
-  => NonNull f
-  -> m (a i Bool)
-fromPointsM points = do
-  arr <- newArray (minimum points, maximum points) False
-  fillAllM (otoList points) arr
-  pure arr
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs b/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs
deleted file mode 100644
index ab7de95e6806..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Level/Village.hs
+++ /dev/null
@@ -1,126 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Generators.Level.Village
-  ( fromCave
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (any, failing, toList)
---------------------------------------------------------------------------------
-import           Control.Monad.Random (MonadRandom)
-import           Control.Monad.State (execStateT, MonadState, modify)
-import           Control.Monad.Trans.Maybe
-import           Control.Parallel.Strategies
-import           Data.Array.IArray
-import           Data.Foldable (any, toList)
---------------------------------------------------------------------------------
-import           Xanthous.Data
-import           Xanthous.Data.EntityMap (EntityMap)
-import qualified Xanthous.Data.EntityMap as EntityMap
-import           Xanthous.Entities.Environment
-import           Xanthous.Generators.Level.Util
-import           Xanthous.Game.State (SomeEntity(..))
-import           Xanthous.Random
---------------------------------------------------------------------------------
-
-fromCave :: MonadRandom m
-         => Cells -- ^ The positions of all the walls
-         -> m (EntityMap SomeEntity)
-fromCave wallPositions = execStateT (fromCave' wallPositions) mempty
-
-fromCave' :: forall m. (MonadRandom m, MonadState (EntityMap SomeEntity) m)
-          => Cells
-          -> m ()
-fromCave' wallPositions = failing (pure ()) $ do
-  Just villageRegion <-
-    choose
-    . (`using` parTraversable rdeepseq)
-    . weightedBy (\reg -> let circSize = length $ circumference reg
-                         in if circSize == 50
-                            then (1.0 :: Double)
-                            else 1.0 / (fromIntegral . abs $ circSize - 50))
-    $ regions closedHallways
-
-  let circ = setFromList . circumference $ villageRegion
-
-  centerPoints <- chooseSubset (0.1 :: Double) $ toList circ
-
-  roomTiles <- foldM
-              (flip $ const $ stepOut circ)
-              (map pure centerPoints)
-              [0 :: Int ..2]
-
-  let roomWalls = circumference . setFromList @(Set _) <$> roomTiles
-      allWalls = join roomWalls
-
-  doorPositions <- fmap join . for roomWalls $ \room ->
-    let candidates = filter (`notMember` circ) room
-    in fmap toList . choose $ ChooseElement candidates
-
-  let entryways =
-        filter (\pt ->
-                  let ncs = neighborCells pt
-                  in any ((&&) <$> (not . (wallPositions !))
-                              <*> (`notMember` villageRegion)) ncs
-                   && any ((&&) <$> (`member` villageRegion)
-                              <*> (`notElem` allWalls)) ncs)
-                  $ toList villageRegion
-
-  Just entryway <- choose $ ChooseElement entryways
-
-  for_ (filter ((&&) <$> (`notElem` doorPositions) <*> (/= entryway)) allWalls)
-    $ insertEntity Wall
-  for_ (filter (/= entryway) doorPositions) $ insertEntity unlockedDoor
-  insertEntity unlockedDoor entryway
-
-
-  where
-    insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e
-    ptToPos pt = _Position # (fromIntegral <$> pt)
-
-    stepOut :: Set (V2 Word) -> [[V2 Word]] -> MaybeT m [[V2 Word]]
-    stepOut circ rooms = for rooms $ \room ->
-      let nextLevels = hashNub $ toList . neighborCells =<< room
-      in pure
-         . (<> room)
-         $ filter ((&&) <$> (`notMember` circ) <*> (`notElem` join rooms))
-         nextLevels
-
-    circumference pts =
-      filter (any (`notMember` pts) . neighborCells) $ toList pts
-    closedHallways = closeHallways livePositions
-    livePositions = amap not wallPositions
-
---------------------------------------------------------------------------------
-
-closeHallways :: Cells -> Cells
-closeHallways livePositions =
-  livePositions // mapMaybe closeHallway (assocs livePositions)
-  where
-    closeHallway (_, False) = Nothing
-    closeHallway (pos, _)
-      | isHallway pos = Just (pos, False)
-      | otherwise     = Nothing
-    isHallway pos = any ((&&) <$> not . view left <*> not . view right)
-      . rotations
-      . fmap (fromMaybe False)
-      $ arrayNeighbors livePositions pos
-
-failing :: Monad m => m a -> MaybeT m a -> m a
-failing result = (maybe result pure =<<) . runMaybeT
-
-{-
-
-import Xanthous.Generators.Village
-import Xanthous.Generators
-import Xanthous.Data
-import System.Random
-import qualified Data.Text
-import qualified Xanthous.Generators.CaveAutomata as CA
-let gi = GeneratorInput SCaveAutomata CA.defaultParams
-wallPositions <- generateFromInput gi (Dimensions 80 50) <$> getStdGen
-putStrLn . Data.Text.unpack $ showCells wallPositions
-
-import Data.Array.IArray
-let closedHallways = closeHallways . amap not $ wallPositions
-putStrLn . Data.Text.unpack . showCells $ amap not closedHallways
-
--}
diff --git a/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs b/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs
deleted file mode 100644
index 8abc00b6a2fc..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Generators/Speech.hs
+++ /dev/null
@@ -1,181 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE OverloadedLists #-}
---------------------------------------------------------------------------------
-module Xanthous.Generators.Speech
-  ( -- * Language definition
-    Language(..)
-    -- ** Lenses
-  , phonotactics
-  , syllablesPerWord
-
-    -- ** Phonotactics
-  , Phonotactics(..)
-    -- *** Lenses
-  , onsets
-  , nuclei
-  , codas
-  , numOnsets
-  , numNuclei
-  , numCodas
-
-    -- * Language generation
-  , syllable
-  , word
-
-    -- * Languages
-  , english
-  , gormlak
-
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (replicateM)
-import           Data.Interval (Interval, (<=..<=))
-import qualified Data.Interval as Interval
-import           Control.Monad.Random.Class (MonadRandom)
-import           Xanthous.Random (chooseRange, choose, ChooseElement (..), Weighted (Weighted))
-import           Control.Monad (replicateM)
-import           Test.QuickCheck (Arbitrary, CoArbitrary, Function)
-import           Test.QuickCheck.Instances.Text ()
-import           Data.List.NonEmpty (NonEmpty)
---------------------------------------------------------------------------------
-
-newtype Phoneme = Phoneme Text
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving newtype (IsString, Semigroup, Monoid, Arbitrary)
-
--- | The phonotactics of a language
---
--- The phonotactics of a language represent the restriction on the phonemes in
--- the syllables of a language.
---
--- Syllables in a language consist of an onset, a nucleus, and a coda (the
--- nucleus and the coda together representing the "rhyme" of the syllable).
-data Phonotactics = Phonotactics
-  { _onsets    :: [Phoneme] -- ^ The permissible onsets, or consonant clusters
-                           --   at the beginning of a syllable
-  , _nuclei    :: [Phoneme] -- ^ The permissible nuclei, or vowel clusters in
-                           --   the middle of a syllable
-  , _codas     :: [Phoneme] -- ^ The permissible codas, or consonant clusters at
-                           --   the end of a syllable
-  , _numOnsets :: Interval Word -- ^ The range of number of allowable onsets
-  , _numNuclei :: Interval Word -- ^ The range of number of allowable nuclei
-  , _numCodas  :: Interval Word -- ^ The range of number of allowable codas
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-makeLenses ''Phonotactics
-
--- | Randomly generate a syllable with the given 'Phonotactics'
-syllable :: MonadRandom m => Phonotactics -> m Text
-syllable phonotactics = do
-  let genPart num choices = do
-        n <- fromIntegral . fromMaybe 0 <$> chooseRange (phonotactics ^. num)
-        fmap (fromMaybe mempty . mconcat)
-          . replicateM n
-          . choose . ChooseElement
-          $ phonotactics ^. choices
-
-  (Phoneme onset) <- genPart numOnsets onsets
-  (Phoneme nucleus) <- genPart numNuclei nuclei
-  (Phoneme coda) <- genPart numCodas codas
-
-  pure $ onset <> nucleus <> coda
-
--- | A definition for a language
---
--- Currently this provides enough information to generate multi-syllabic words,
--- but in the future will likely also include grammar-related things.
-data Language = Language
-  { _phonotactics :: Phonotactics
-  , _syllablesPerWord :: Weighted Int NonEmpty Int
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-makeLenses ''Language
-
-word :: MonadRandom m => Language -> m Text
-word lang = do
-  numSyllables <- choose $ lang ^. syllablesPerWord
-  mconcat <$> replicateM numSyllables (syllable $ lang ^. phonotactics)
-
---------------------------------------------------------------------------------
-
--- <https://en.wikipedia.org/wiki/English_phonology#Phonotactics>
-englishPhonotactics :: Phonotactics
-englishPhonotactics = Phonotactics
-  { _onsets = [ "pl" , "bl" , "kl" , "gl" , "pr" , "br" , "tr" , "dr" , "kr"
-              , "gr" , "tw" , "dw" , "gw" , "kw" , "pw"
-
-              , "fl" , "sl" , {- "thl", -} "shl" {- , "vl" -}
-              , "p", "b", "t", "d", "k", "ɡ", "m", "n", "f", "v", "th", "s"
-              , "z", "h", "l", "w"
-
-              , "sp", "st", "sk"
-
-              , "sm", "sn"
-
-              , "sf", "sth"
-
-              , "spl", "skl", "spr", "str", "skr", "skw", "sm", "sp", "st", "sk"
-              ]
-  , _nuclei = [ "a", "e", "i", "o", "u", "ur", "ar", "or", "ear", "are", "ure"
-              , "oa", "ee", "oo", "ei", "ie", "oi", "ou"
-              ]
-  , _codas = [ "m", "n", "ng", "p", "t", "tsh", "k", "f", "sh", "s", "th", "x"
-             , "v", "z", "zh", "l", "r", "w"
-
-             , "lk", "lb", "lt", "ld", "ltsh", "ldsh", "lk"
-             , "rp", "rb", "rt", "rd", "rtsh", "rdsh", "rk", "rɡ"
-             , "lf", "lv", "lth", "ls", "lz", "lsh", "lth"
-             , "rf", "rv", "rth", "rs", "rz", "rth"
-             , "lm", "ln"
-             , "rm", "rn", "rl"
-             , "mp", "nt", "nd", "nth", "nsh", "nk"
-             , "mf", "ms", "mth", "nf", "nth", "ns", "nz", "nth"
-             , "ft", "sp", "st", "sk"
-             , "fth"
-             , "pt", "kt"
-             , "pth", "ps", "th", "ts", "dth", "dz", "ks"
-             , "lpt", "lps", "lfth", "lts", "lst", "lkt", "lks"
-             , "rmth", "rpt", "rps", "rts", "rst", "rkt"
-             , "mpt", "mps", "ndth", "nkt", "nks", "nkth"
-             , "ksth", "kst"
-             ]
-  , _numOnsets = 0 <=..<= 1
-  , _numNuclei = Interval.singleton 1
-  , _numCodas  = 0 <=..<= 1
-  }
-
-english :: Language
-english = Language
-  { _phonotactics = englishPhonotactics
-  , _syllablesPerWord = Weighted [(20, 1),
-                                  (7,  2),
-                                  (2,  3),
-                                  (1,  4)]
-  }
-
-gormlakPhonotactics :: Phonotactics
-gormlakPhonotactics = Phonotactics
- { _onsets = [ "h", "l", "g", "b", "m", "n", "ng"
-             , "gl", "bl", "fl"
-             ]
- , _numOnsets = Interval.singleton 1
- , _nuclei = [ "a", "o", "aa", "u" ]
- , _numNuclei = Interval.singleton 1
- , _codas = [ "r", "l", "g", "m", "n"
-            , "rl", "gl", "ml", "rm"
-            , "n", "k"
-            ]
- , _numCodas = Interval.singleton 1
- }
-
-gormlak :: Language
-gormlak = Language
-  { _phonotactics = gormlakPhonotactics
-  , _syllablesPerWord = Weighted [ (5, 2)
-                                 , (5, 1)
-                                 , (1, 3)
-                                 ]
-  }
diff --git a/users/grfn/xanthous/src/Xanthous/Messages.hs b/users/grfn/xanthous/src/Xanthous/Messages.hs
deleted file mode 100644
index c273d650821b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Messages.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Messages
-  ( Message(..)
-  , resolve
-  , MessageMap(..)
-  , lookupMessage
-
-    -- * Game messages
-  , messages
-  , render
-  , render_
-  , lookup
-  , message
-  , message_
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (lookup)
---------------------------------------------------------------------------------
-import           Control.Monad.Random.Class (MonadRandom)
-import           Data.Aeson (FromJSON, ToJSON, toJSON, object)
-import qualified Data.Aeson as JSON
-import           Data.Aeson.Generic.DerivingVia
-import           Data.FileEmbed
-import           Data.List.NonEmpty
-import           Test.QuickCheck hiding (choose)
-import           Test.QuickCheck.Instances.UnorderedContainers ()
-import           Text.Mustache
-import qualified Data.Yaml as Yaml
---------------------------------------------------------------------------------
-import           Xanthous.Random
-import           Xanthous.Orphans ()
---------------------------------------------------------------------------------
-
-data Message = Single Template | Choice (NonEmpty Template)
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (CoArbitrary, Function, NFData)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ SumEnc UntaggedVal ]
-           Message
-
-instance Arbitrary Message where
-  arbitrary =
-    frequency [ (10, Single <$> arbitrary)
-              , (1, Choice <$> arbitrary)
-              ]
-  shrink = genericShrink
-
-resolve :: MonadRandom m => Message -> m Template
-resolve (Single t) = pure t
-resolve (Choice ts) = choose ts
-
-data MessageMap = Direct Message | Nested (HashMap Text MessageMap)
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (CoArbitrary, Function, NFData)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ SumEnc UntaggedVal ]
-           MessageMap
-
-instance Arbitrary MessageMap where
-  arbitrary = frequency [ (10, Direct <$> arbitrary)
-                        , (1, Nested <$> arbitrary)
-                        ]
-
-lookupMessage :: [Text] -> MessageMap -> Maybe Message
-lookupMessage [] (Direct msg) = Just msg
-lookupMessage (k:ks) (Nested m) = lookupMessage ks =<< m ^. at k
-lookupMessage _ _ = Nothing
-
-type instance Index MessageMap = [Text]
-type instance IxValue MessageMap = Message
-instance Ixed MessageMap where
-  ix [] f (Direct msg) = Direct <$> f msg
-  ix (k:ks) f (Nested m) = case m ^. at k of
-    Just m' -> ix ks f m' <&> \m'' ->
-      Nested $ m & at k ?~ m''
-    Nothing -> pure $ Nested m
-  ix _ _ m = pure m
-
---------------------------------------------------------------------------------
-
-rawMessages :: ByteString
-rawMessages = $(embedFile "src/Xanthous/messages.yaml")
-
-messages :: MessageMap
-messages
-  = either (error . Yaml.prettyPrintParseException) id
-  $ Yaml.decodeEither' rawMessages
-
-render :: (MonadRandom m, ToJSON params) => Message -> params -> m Text
-render msg params = do
-  tpl <- resolve msg
-  pure . toStrict . renderMustache tpl $ toJSON params
-
--- | Render a message with an empty set of params
-render_ :: (MonadRandom m) => Message -> m Text
-render_ msg = render msg $ object []
-
-lookup :: [Text] -> Message
-lookup path = fromMaybe notFound $ messages ^? ix path
-  where notFound
-          = Single
-          $ compileMustacheText "template" "Message not found"
-          ^?! _Right
-
-message :: (MonadRandom m, ToJSON params) => [Text] -> params -> m Text
-message path params = maybe notFound (`render` params) $ messages ^? ix path
-  where
-    notFound = pure "Message not found"
-
-message_ :: (MonadRandom m) => [Text] -> m Text
-message_ path = maybe notFound (`render` JSON.object []) $ messages ^? ix path
-  where
-    notFound = pure "Message not found"
diff --git a/users/grfn/xanthous/src/Xanthous/Messages/Template.hs b/users/grfn/xanthous/src/Xanthous/Messages/Template.hs
deleted file mode 100644
index 5176880355f4..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Messages/Template.hs
+++ /dev/null
@@ -1,275 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
---------------------------------------------------------------------------------
-module Xanthous.Messages.Template
-  ( -- * Template AST
-    Template(..)
-  , Substitution(..)
-  , Filter(..)
-
-    -- ** Template AST transformations
-  , reduceTemplate
-
-    -- * Template parser
-  , template
-  , runParser
-  , errorBundlePretty
-
-    -- * Template pretty-printer
-  , ppTemplate
-
-    -- * Rendering templates
-  , TemplateVar(..)
-  , nested
-  , TemplateVars(..)
-  , vars
-  , RenderError
-  , render
-  )
-where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding
-                 (many, concat, try, elements, some, parts)
---------------------------------------------------------------------------------
-import           Test.QuickCheck hiding (label)
-import           Test.QuickCheck.Instances.Text ()
-import           Test.QuickCheck.Instances.Semigroup ()
-import           Test.QuickCheck.Checkers (EqProp)
-import           Control.Monad.Combinators.NonEmpty
-import           Data.List.NonEmpty (NonEmpty(..))
-import           Data.Data
-import           Text.Megaparsec hiding (sepBy1, some)
-import           Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import           Data.Function (fix)
---------------------------------------------------------------------------------
-import Xanthous.Util (EqEqProp(..))
---------------------------------------------------------------------------------
-
-genIdentifier :: Gen Text
-genIdentifier = pack <$> listOf1 (elements identifierChars)
-
-identifierChars :: String
-identifierChars = ['a'..'z'] <> ['A'..'Z'] <> ['-', '_']
-
-newtype Filter = FilterName Text
-  deriving stock (Show, Eq, Ord, Generic, Data)
-  deriving anyclass (NFData)
-  deriving (IsString) via Text
-
-instance Arbitrary Filter where
-  arbitrary = FilterName <$> genIdentifier
-  shrink (FilterName fn) = fmap FilterName . filter (not . null) $ shrink fn
-
-data Substitution
-  = SubstPath (NonEmpty Text)
-  | SubstFilter Substitution Filter
-  deriving stock (Show, Eq, Ord, Generic, Data)
-  deriving anyclass (NFData)
-
-instance Arbitrary Substitution where
-  arbitrary = sized . fix $ \gen n ->
-    let leaves =
-          [ SubstPath <$> ((:|) <$> genIdentifier <*> listOf genIdentifier)]
-        subtree = gen $ n `div` 2
-    in if n == 0
-       then oneof leaves
-       else oneof $ leaves <> [ SubstFilter <$> subtree <*> arbitrary ]
-  shrink (SubstPath pth) =
-    fmap SubstPath
-    . filter (not . any ((||) <$> null <*> any (`notElem` identifierChars)))
-    $ shrink pth
-  shrink (SubstFilter s f)
-    = shrink s
-    <> (uncurry SubstFilter <$> shrink (s, f))
-
-data Template
-  = Literal Text
-  | Subst Substitution
-  | Concat Template Template
-  deriving stock (Show, Generic, Data)
-  deriving anyclass (NFData)
-  deriving EqProp via EqEqProp Template
-
-instance Plated Template where
-  plate _ tpl@(Literal _) = pure tpl
-  plate _ tpl@(Subst _) = pure tpl
-  plate f (Concat tpl₁ tpl₂) = Concat <$> f tpl₁ <*> f tpl₂
-
-reduceTemplate :: Template -> Template
-reduceTemplate = transform $ \case
-  (Concat (Literal t₁) (Literal t₂)) -> Literal (t₁ <> t₂)
-  (Concat (Literal "") t) -> t
-  (Concat t (Literal "")) -> t
-  (Concat t₁ (Concat t₂ t₃)) -> Concat (Concat t₁ t₂) t₃
-  (Concat (Concat t₁ (Literal t₂)) (Literal t₃)) -> (Concat t₁ (Literal $ t₂ <> t₃))
-  t -> t
-
-instance Eq Template where
-  tpl₁ == tpl₂ = case (reduceTemplate tpl₁, reduceTemplate tpl₂) of
-    (Literal t₁, Literal t₂) -> t₁ == t₂
-    (Subst s₁, Subst s₂) -> s₁ == s₂
-    (Concat ta₁ ta₂, Concat tb₁ tb₂) -> ta₁ == tb₁ && ta₂ == tb₂
-    _ -> False
-
-instance Arbitrary Template where
-  arbitrary = sized . fix $ \gen n ->
-    let leaves = [ Literal . pack . filter (`notElem` ['\\', '{']) <$> arbitrary
-                 , Subst <$> arbitrary
-                 ]
-        subtree = gen $ n `div` 2
-        genConcat = Concat <$> subtree <*> subtree
-    in if n == 0
-       then oneof leaves
-       else oneof $ genConcat : leaves
-  shrink (Literal t) = Literal <$> shrink t
-  shrink (Subst s) = Subst <$> shrink s
-  shrink (Concat t₁ t₂)
-    = shrink t₁
-    <> shrink t₂
-    <> (Concat <$> shrink t₁ <*> shrink t₂)
-
-instance Semigroup Template where
-  (<>) = Concat
-
-instance Monoid Template where
-  mempty = Literal ""
-
---------------------------------------------------------------------------------
-
-type Parser = Parsec Void Text
-
-sc :: Parser ()
-sc = L.space space1 empty empty
-
-lexeme :: Parser a -> Parser a
-lexeme = L.lexeme sc
-
-symbol :: Text -> Parser Text
-symbol = L.symbol sc
-
-identifier :: Parser Text
-identifier = lexeme . label "identifier" $ do
-  firstChar <- letterChar <|> oneOf ['-', '_']
-  restChars <- many $ alphaNumChar <|> oneOf ['-', '_']
-  pure $ firstChar <| pack restChars
-
-filterName :: Parser Filter
-filterName = FilterName <$> identifier
-
-substitutionPath :: Parser Substitution
-substitutionPath = SubstPath <$> sepBy1 identifier (char '.')
-
-substitutionFilter :: Parser Substitution
-substitutionFilter = do
-  path <- substitutionPath
-  fs <- some $ symbol "|" *> filterName
-  pure $ foldl' SubstFilter path fs
-  -- pure $ SubstFilter path f
-
-substitutionContents :: Parser Substitution
-substitutionContents
-  =   try substitutionFilter
-  <|> substitutionPath
-
-substitution :: Parser Substitution
-substitution = between (string "{{") (string "}}") substitutionContents
-
-literal :: Parser Template
-literal = Literal <$>
-  (   (string "\\{" $> "{")
-  <|> takeWhile1P Nothing (`notElem` ['\\', '{'])
-  )
-
-subst :: Parser Template
-subst = Subst <$> substitution
-
-template' :: Parser Template
-template' = do
-  parts <- many $ literal <|> subst
-  pure $ foldr Concat (Literal "") parts
-
-
-template :: Parser Template
-template = reduceTemplate <$> template' <* eof
-
---------------------------------------------------------------------------------
-
-ppSubstitution :: Substitution -> Text
-ppSubstitution (SubstPath substParts) = intercalate "." substParts
-ppSubstitution (SubstFilter s (FilterName f)) = ppSubstitution s <> " | " <> f
-
-ppTemplate :: Template -> Text
-ppTemplate (Literal txt) = txt
-ppTemplate (Subst s) = "{{" <> ppSubstitution s <> "}}"
-ppTemplate (Concat tpl₁ tpl₂) = ppTemplate tpl₁ <> ppTemplate tpl₂
-
---------------------------------------------------------------------------------
-
-data TemplateVar
-  = Val Text
-  | Nested (Map Text TemplateVar)
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-nested :: [(Text, TemplateVar)] -> TemplateVar
-nested = Nested . mapFromList
-
-instance Arbitrary TemplateVar where
-  arbitrary = sized . fix $ \gen n ->
-    let nst = fmap mapFromList . listOf $ (,) <$> arbitrary <*> gen (n `div` 2)
-    in if n == 0
-       then Val <$> arbitrary
-       else oneof [ Val <$> arbitrary
-                  , Nested <$> nst]
-
-newtype TemplateVars = Vars { getTemplateVars :: Map Text TemplateVar }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-  deriving (Arbitrary) via (Map Text TemplateVar)
-
-type instance Index TemplateVars = Text
-type instance IxValue TemplateVars = TemplateVar
-instance Ixed TemplateVars where
-  ix k f (Vars vs) = Vars <$> ix k f vs
-instance At TemplateVars where
-  at k f (Vars vs) = Vars <$> at k f vs
-
-vars :: [(Text, TemplateVar)] -> TemplateVars
-vars = Vars . mapFromList
-
-lookupVar :: TemplateVars -> NonEmpty Text -> Maybe TemplateVar
-lookupVar vs (p :| []) = vs ^. at p
-lookupVar vs (p :| (p₁ : ps)) = vs ^. at p >>= \case
-  (Val _) -> Nothing
-  (Nested vs') -> lookupVar (Vars vs') $ p₁ :| ps
-
-data RenderError
-  = NoSuchVariable (NonEmpty Text)
-  | NestedFurther (NonEmpty Text)
-  | NoSuchFilter Filter
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData)
-
-renderSubst
-  :: Map Filter (Text -> Text) -- ^ Filters
-  -> TemplateVars
-  -> Substitution
-  -> Either RenderError Text
-renderSubst _ vs (SubstPath pth) =
-  case lookupVar vs pth of
-    Just (Val v) -> Right v
-    Just (Nested _) -> Left $ NestedFurther pth
-    Nothing -> Left $ NoSuchVariable pth
-renderSubst fs vs (SubstFilter s fn) =
-  case fs ^. at fn of
-    Just filterFn -> filterFn <$> renderSubst fs vs s
-    Nothing -> Left $ NoSuchFilter fn
-
-render
-  :: Map Filter (Text -> Text) -- ^ Filters
-  -> TemplateVars             -- ^ Template variables
-  -> Template                 -- ^ Template
-  -> Either RenderError Text
-render _ _ (Literal s) = pure s
-render fs vs (Concat t₁ t₂) = (<>) <$> render fs vs t₁ <*> render fs vs t₂
-render fs vs (Subst s) = renderSubst fs vs s
diff --git a/users/grfn/xanthous/src/Xanthous/Monad.hs b/users/grfn/xanthous/src/Xanthous/Monad.hs
deleted file mode 100644
index db602de56f3a..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Monad.hs
+++ /dev/null
@@ -1,76 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Monad
-  ( AppT(..)
-  , AppM
-  , runAppT
-  , continue
-  , halt
-
-    -- * Messages
-  , say
-  , say_
-  , message
-  , message_
-  , writeMessage
-
-    -- * Autocommands
-  , cancelAutocommand
-
-    -- * Events
-  , sendEvent
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Control.Monad.Random
-import           Control.Monad.State
-import qualified Brick
-import           Brick (EventM, Next)
-import           Brick.BChan (writeBChan)
-import           Data.Aeson (ToJSON, object)
---------------------------------------------------------------------------------
-import           Xanthous.Data.App (AppEvent)
-import           Xanthous.Game.State
-import           Xanthous.Game.Env
-import           Xanthous.Messages (Message)
-import qualified Xanthous.Messages as Messages
---------------------------------------------------------------------------------
-
-halt :: AppT (EventM n) (Next GameState)
-halt = lift . Brick.halt =<< get
-
-continue :: AppT (EventM n) (Next GameState)
-continue = lift . Brick.continue =<< get
-
---------------------------------------------------------------------------------
-
-say :: (MonadRandom m, ToJSON params, MonadState GameState m)
-    => [Text] -> params -> m ()
-say msgPath = writeMessage <=< Messages.message msgPath
-
-say_ :: (MonadRandom m, MonadState GameState m) => [Text] -> m ()
-say_ msgPath = say msgPath $ object []
-
-message :: (MonadRandom m, ToJSON params, MonadState GameState m)
-        => Message -> params -> m ()
-message msg = writeMessage <=< Messages.render msg
-
-message_ :: (MonadRandom m, MonadState GameState m)
-         => Message ->  m ()
-message_ msg = message msg $ object []
-
-writeMessage :: MonadState GameState m => Text -> m ()
-writeMessage m = messageHistory %= pushMessage m
-
--- | Cancel the currently active autocommand, if any
-cancelAutocommand :: (MonadState GameState m, MonadIO m) => m ()
-cancelAutocommand = do
-  traverse_ (liftIO . cancel . snd) =<< preuse (autocommand . _ActiveAutocommand)
-  autocommand .= NoAutocommand
-
---------------------------------------------------------------------------------
-
--- | Send an event to the app in an environment where the game env is available
-sendEvent :: (MonadReader GameEnv m, MonadIO m) => AppEvent -> m ()
-sendEvent evt = do
-  ec <- view eventChan
-  liftIO $ writeBChan ec evt
diff --git a/users/grfn/xanthous/src/Xanthous/Orphans.hs b/users/grfn/xanthous/src/Xanthous/Orphans.hs
deleted file mode 100644
index 66004163f6ea..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Orphans.hs
+++ /dev/null
@@ -1,495 +0,0 @@
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE StandaloneDeriving    #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE PackageImports        #-}
-{-# OPTIONS_GHC -Wno-orphans       #-}
-{-# OPTIONS_GHC -Wno-type-defaults #-}
---------------------------------------------------------------------------------
-module Xanthous.Orphans
-  ( ppTemplate
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (elements, (.=))
---------------------------------------------------------------------------------
-import           Data.Aeson hiding (Key)
-import qualified Data.Aeson.KeyMap as KM
-import           Data.Aeson.Types (typeMismatch)
-import           Data.List.NonEmpty (NonEmpty(..))
-import qualified Graphics.Vty.Input
-import           Graphics.Vty.Attributes
-import           Brick.Widgets.Edit
-import           Data.Text.Zipper.Generic (GenericTextZipper)
-import           Brick.Widgets.Core (getName)
-import           System.Random.Internal (StdGen (..))
-import           System.Random.SplitMix (SMGen ())
-import           Test.QuickCheck
--- import           Test.QuickCheck.Arbitrary.Generic (Arg ())
-import           "quickcheck-instances" Test.QuickCheck.Instances ()
-import           Text.Megaparsec (errorBundlePretty)
-import           Text.Megaparsec.Pos
-import           Text.Mustache
-import           Text.Mustache.Type ( showKey )
-import           Control.Monad.State
-import           Linear
-import qualified Data.Interval as Interval
-import           Data.Interval ( Interval, Extended (..), Boundary (..)
-                               , lowerBound', upperBound', (<=..<), (<=..<=)
-                               , interval)
-import           Test.QuickCheck.Checkers (EqProp ((=-=)))
---------------------------------------------------------------------------------
-import           Xanthous.Util.JSON
-import           Xanthous.Util.QuickCheck
-import           Xanthous.Util (EqEqProp(EqEqProp))
-import qualified Graphics.Vty.Input.Events
---------------------------------------------------------------------------------
-
-instance forall s a.
-  ( Cons s s a a
-  , IsSequence s
-  , Element s ~ a
-  ) => Cons (NonNull s) (NonNull s) a a where
-  _Cons = prism hither yon
-    where
-      hither :: (a, NonNull s) -> NonNull s
-      hither (a, ns) =
-        let s = toNullable ns
-        in impureNonNull $ a <| s
-
-      yon :: NonNull s -> Either (NonNull s) (a, NonNull s)
-      yon ns = case nuncons ns of
-        (_, Nothing) -> Left ns
-        (x, Just xs) -> Right (x, xs)
-
-instance forall a. Cons (NonEmpty a) (NonEmpty a) a a where
-  _Cons = prism hither yon
-    where
-      hither :: (a, NonEmpty a) -> NonEmpty a
-      hither (a, x :| xs) = a :| (x : xs)
-
-      yon :: NonEmpty a -> Either (NonEmpty a) (a, NonEmpty a)
-      yon ns@(x :| xs) = case xs of
-        (y : ys) -> Right (x, y :| ys)
-        [] -> Left ns
-
-
-instance Arbitrary PName where
-  arbitrary = PName . pack <$> listOf1 (elements ['a'..'z'])
-
-instance Arbitrary Key where
-  arbitrary = Key <$> listOf1 arbSafeText
-    where arbSafeText = pack <$> listOf1 (elements ['a'..'z'])
-  shrink (Key []) = error "unreachable"
-  shrink k@(Key [_]) = pure k
-  shrink (Key (p:ps)) = Key . (p :) <$> shrink ps
-
-instance Arbitrary Pos where
-  arbitrary = mkPos . succ . abs <$> arbitrary
-  shrink (unPos -> 1) = []
-  shrink (unPos -> x) = mkPos <$> [x..1]
-
-instance Arbitrary Node where
-  arbitrary = scale (`div` 10) $ sized node
-    where
-      node n | n > 0 = oneof $ leaves ++ branches (n `div` 4)
-      node _ = oneof leaves
-      branches n =
-        [ Section <$> arbitrary <*> subnodes n
-        , InvertedSection <$> arbitrary <*> subnodes n
-        ]
-      subnodes = fmap concatTextBlocks . listOf . node
-      leaves =
-        [ TextBlock . pack <$> listOf1 (elements ['a'..'z'])
-        , EscapedVar <$> arbitrary
-        , UnescapedVar <$> arbitrary
-        -- TODO fix pretty-printing of mustache partials
-        -- , Partial <$> arbitrary <*> arbitrary
-        ]
-  shrink = genericShrink
-
-concatTextBlocks :: [Node] -> [Node]
-concatTextBlocks [] = []
-concatTextBlocks [x] = [x]
-concatTextBlocks (TextBlock txt₁ : TextBlock txt₂ : xs)
-  = concatTextBlocks $ TextBlock (txt₁ <> txt₂) : concatTextBlocks xs
-concatTextBlocks (x : xs) = x : concatTextBlocks xs
-
-instance Arbitrary Template where
-  arbitrary = scale (`div` 8) $ do
-    template <- concatTextBlocks <$> arbitrary
-    -- templateName <- arbitrary
-    -- rest <- arbitrary
-    let templateName = "template"
-        rest = mempty
-    pure $ Template
-      { templateActual = templateName
-      , templateCache = rest & at templateName ?~ template
-      }
-  shrink (Template actual cache) =
-    let Just tpl = cache ^. at actual
-    in do
-      cache' <- shrink cache
-      tpl' <- shrink tpl
-      actual' <- shrink actual
-      pure $ Template
-        { templateActual = actual'
-        , templateCache = cache' & at actual' ?~ tpl'
-        }
-
-instance CoArbitrary Template where
-  coarbitrary = coarbitrary . ppTemplate
-
-instance Function Template where
-  function = functionMap ppTemplate parseTemplatePartial
-    where
-      parseTemplatePartial txt
-        = compileMustacheText "template" txt ^?! _Right
-
-ppNode :: Map PName [Node] -> Node -> Text
-ppNode _ (TextBlock txt) = txt
-ppNode _ (EscapedVar k) = "{{" <> showKey k <> "}}"
-ppNode ctx (Section k body) =
-  let sk = showKey k
-  in "{{#" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}"
-ppNode _ (UnescapedVar k) = "{{{" <> showKey k <> "}}}"
-ppNode ctx (InvertedSection k body) =
-  let sk = showKey k
-  in "{{^" <> sk <> "}}" <> foldMap (ppNode ctx) body <> "{{/" <> sk <> "}}"
-ppNode _ (Partial n _) = "{{> " <> unPName n <> "}}"
-
-ppTemplate :: Template -> Text
-ppTemplate (Template actual cache) =
-  case cache ^. at actual of
-    Nothing -> error "Template not found?"
-    Just nodes -> foldMap (ppNode cache) nodes
-
-instance ToJSON Template where
-  toJSON = String . ppTemplate
-
-instance FromJSON Template where
-  parseJSON
-    = withText "Template"
-    $ either (fail . errorBundlePretty) pure
-    . compileMustacheText "template"
-
-deriving anyclass instance NFData Node
-deriving anyclass instance NFData Template
-
-instance FromJSON Color where
-  parseJSON (String "black")         = pure black
-  parseJSON (String "red")           = pure red
-  parseJSON (String "green")         = pure green
-  parseJSON (String "yellow")        = pure yellow
-  parseJSON (String "blue")          = pure blue
-  parseJSON (String "magenta")       = pure magenta
-  parseJSON (String "cyan")          = pure cyan
-  parseJSON (String "white")         = pure white
-  parseJSON (String "brightBlack")   = pure brightBlack
-  parseJSON (String "brightRed")     = pure brightRed
-  parseJSON (String "brightGreen")   = pure brightGreen
-  parseJSON (String "brightYellow")  = pure brightYellow
-  parseJSON (String "brightBlue")    = pure brightBlue
-  parseJSON (String "brightMagenta") = pure brightMagenta
-  parseJSON (String "brightCyan")    = pure brightCyan
-  parseJSON (String "brightWhite")   = pure brightWhite
-  parseJSON n@(Number _)             = Color240 <$> parseJSON n
-  parseJSON x                        = typeMismatch "Color" x
-
-instance ToJSON Color where
-  toJSON color
-    | color == black         = "black"
-    | color == red           = "red"
-    | color == green         = "green"
-    | color == yellow        = "yellow"
-    | color == blue          = "blue"
-    | color == magenta       = "magenta"
-    | color == cyan          = "cyan"
-    | color == white         = "white"
-    | color == brightBlack   = "brightBlack"
-    | color == brightRed     = "brightRed"
-    | color == brightGreen   = "brightGreen"
-    | color == brightYellow  = "brightYellow"
-    | color == brightBlue    = "brightBlue"
-    | color == brightMagenta = "brightMagenta"
-    | color == brightCyan    = "brightCyan"
-    | color == brightWhite   = "brightWhite"
-    | Color240 num <- color  = toJSON num
-    | otherwise             = error $ "unimplemented: " <> show color
-
-instance (Eq a, Show a, Read a, FromJSON a) => FromJSON (MaybeDefault a) where
-  parseJSON Null                   = pure Default
-  parseJSON (String "keepCurrent") = pure KeepCurrent
-  parseJSON x                      = SetTo <$> parseJSON x
-
-instance ToJSON a => ToJSON (MaybeDefault a) where
-  toJSON Default     = Null
-  toJSON KeepCurrent = String "keepCurrent"
-  toJSON (SetTo x)   = toJSON x
-
---------------------------------------------------------------------------------
-
-instance Arbitrary Color where
-  arbitrary = oneof [ Color240 <$> choose (0, 239)
-                    , ISOColor <$> choose (0, 15)
-                    ]
-
-deriving anyclass instance CoArbitrary Color
-deriving anyclass instance Function Color
-
-instance (Eq a, Show a, Read a, Arbitrary a) => Arbitrary (MaybeDefault a) where
-  arbitrary = oneof [ pure Default
-                    , pure KeepCurrent
-                    , SetTo <$> arbitrary
-                    ]
-
-instance CoArbitrary a => CoArbitrary (MaybeDefault a) where
-  coarbitrary Default = variant @Int 1
-  coarbitrary KeepCurrent = variant @Int 2
-  coarbitrary (SetTo x) = variant @Int 3 . coarbitrary x
-
-instance (Eq a, Show a, Read a, Function a) => Function (MaybeDefault a) where
-  function = functionShow
-
-deriving via (EqEqProp Attr) instance EqProp Attr
-
-instance Arbitrary Attr where
-  arbitrary = do
-    attrStyle <- arbitrary
-    attrForeColor <- arbitrary
-    attrBackColor <- arbitrary
-    attrURL <- arbitrary
-    pure Attr {..}
-
-deriving anyclass instance CoArbitrary Attr
-deriving anyclass instance Function Attr
-
-instance ToJSON Attr where
-  toJSON Attr{..} = object
-    [ "style" .= maybeDefaultToJSONWith styleToJSON attrStyle
-    , "foreground" .= attrForeColor
-    , "background" .= attrBackColor
-    , "url" .= attrURL
-    ]
-    where
-      maybeDefaultToJSONWith _ Default = Null
-      maybeDefaultToJSONWith _ KeepCurrent = String "keepCurrent"
-      maybeDefaultToJSONWith tj (SetTo x) = tj x
-      styleToJSON style
-        | style == standout     = "standout"
-        | style == underline    = "underline"
-        | style == reverseVideo = "reverseVideo"
-        | style == blink        = "blink"
-        | style == dim          = "dim"
-        | style == bold         = "bold"
-        | style == italic       = "italic"
-        | otherwise            = toJSON style
-
-instance FromJSON Attr where
-  parseJSON = withObject "Attr" $ \obj -> do
-    attrStyle <- parseStyle =<< obj .:? "style" .!= Default
-    attrForeColor <- obj .:? "foreground" .!= Default
-    attrBackColor <- obj .:? "background" .!= Default
-    attrURL <- obj .:? "url" .!= Default
-    pure Attr{..}
-
-    where
-      parseStyle (SetTo (String "standout"))     = pure (SetTo standout)
-      parseStyle (SetTo (String "underline"))    = pure (SetTo underline)
-      parseStyle (SetTo (String "reverseVideo")) = pure (SetTo reverseVideo)
-      parseStyle (SetTo (String "blink"))        = pure (SetTo blink)
-      parseStyle (SetTo (String "dim"))          = pure (SetTo dim)
-      parseStyle (SetTo (String "bold"))         = pure (SetTo bold)
-      parseStyle (SetTo (String "italic"))       = pure (SetTo italic)
-      parseStyle (SetTo n@(Number _))            = SetTo <$> parseJSON n
-      parseStyle (SetTo v)                       = typeMismatch "Style" v
-      parseStyle Default                         = pure Default
-      parseStyle KeepCurrent                     = pure KeepCurrent
-
-deriving stock instance Ord Color
-deriving stock instance Ord a => Ord (MaybeDefault a)
-deriving stock instance Ord Attr
-
-deriving anyclass instance Hashable Graphics.Vty.Input.Events.Key
-deriving anyclass instance Hashable Graphics.Vty.Input.Events.Modifier
-
---------------------------------------------------------------------------------
-
-instance (SemiSequence a, Arbitrary (Element a), Arbitrary a)
-         => Arbitrary (NonNull a) where
-  arbitrary = ncons <$> arbitrary <*> arbitrary
-
-instance ToJSON a => ToJSON (NonNull a) where
-  toJSON = toJSON . toNullable
-
-instance (FromJSON a, MonoFoldable a) => FromJSON (NonNull a) where
-  parseJSON = maybe (fail "Found empty list") pure . fromNullable <=< parseJSON
-
-instance NFData a => NFData (NonNull a) where
-  rnf xs = xs `seq` toNullable xs `deepseq` ()
-
---------------------------------------------------------------------------------
-
-instance forall t name. (NFData t, Monoid t, NFData name)
-                 => NFData (Editor t name) where
-  rnf ed = getName @_ @name ed `deepseq` getEditContents ed `deepseq` ()
-
-deriving via (ReadShowJSON SMGen) instance ToJSON SMGen
-deriving via (ReadShowJSON SMGen) instance FromJSON SMGen
-
-instance ToJSON StdGen where
-  toJSON = toJSON . unStdGen
-  toEncoding = toEncoding . unStdGen
-
-instance FromJSON StdGen where
-  parseJSON = fmap StdGen . parseJSON
-
---------------------------------------------------------------------------------
-
-instance CoArbitrary a => CoArbitrary (NonNull a) where
-  coarbitrary = coarbitrary . toNullable
-
-instance (MonoFoldable a, Function a) => Function (NonNull a) where
-  function = functionMap toNullable $ fromMaybe (error "null") . fromNullable
-
-instance (Arbitrary t, Arbitrary n, GenericTextZipper t)
-       => Arbitrary (Editor t n) where
-  arbitrary = editor <$> arbitrary <*> arbitrary <*> arbitrary
-
-instance forall t n. (CoArbitrary t, CoArbitrary n, Monoid t)
-              => CoArbitrary (Editor t n) where
-  coarbitrary ed = coarbitrary (getName @_ @n ed, getEditContents ed)
-
-instance CoArbitrary StdGen where
-  coarbitrary = coarbitrary . show
-
-instance Function StdGen where
-  function = functionMap unStdGen StdGen
-
-instance Function SMGen where
-  function = functionShow
-
---------------------------------------------------------------------------------
-
-deriving newtype instance (Arbitrary s, CoArbitrary (m (a, s)))
-            => CoArbitrary (StateT s m a)
-
---------------------------------------------------------------------------------
-
-deriving via (GenericArbitrary (V2 a)) instance (Arbitrary a) => Arbitrary (V2 a)
-instance CoArbitrary a => CoArbitrary (V2 a)
-instance Function a => Function (V2 a)
-
---------------------------------------------------------------------------------
-
-instance CoArbitrary Boundary
-instance Function Boundary
-
-instance Arbitrary a => Arbitrary (Extended a) where
-  arbitrary = oneof [ pure NegInf
-                    , pure PosInf
-                    , Finite <$> arbitrary
-                    ]
-
-instance CoArbitrary a => CoArbitrary (Extended a) where
-  coarbitrary NegInf = variant 1
-  coarbitrary PosInf = variant 2
-  coarbitrary (Finite x) = variant 3 . coarbitrary x
-
-instance (Function a) => Function (Extended a) where
-  function = functionMap g h
-    where
-     g NegInf = Left True
-     g (Finite a) = Right a
-     g PosInf = Left False
-     h (Left False) = PosInf
-     h (Left True) = NegInf
-     h (Right a) = Finite a
-
-instance ToJSON a => ToJSON (Extended a) where
-  toJSON NegInf = String "NegInf"
-  toJSON PosInf = String "PosInf"
-  toJSON (Finite x) = toJSON x
-
-instance FromJSON a => FromJSON (Extended a) where
-  parseJSON (String "NegInf") = pure NegInf
-  parseJSON (String "PosInf") = pure PosInf
-  parseJSON val               = Finite <$> parseJSON val
-
-instance (EqProp a, Show a) => EqProp (Extended a) where
-  NegInf =-= NegInf = property True
-  PosInf =-= PosInf = property True
-  (Finite x) =-= (Finite y) = x =-= y
-  x =-= y = counterexample (show x <> " /= " <> show y) False
-
-instance Arbitrary Interval.Boundary where
-  arbitrary = elements [ Interval.Open , Interval.Closed ]
-
-instance (Ord r, Arbitrary r) => Arbitrary (Interval r) where
-  arbitrary = do
-    lower <- arbitrary
-    upper <- arbitrary
-    pure $ (if upper < lower then flip else id)
-      Interval.interval
-      lower
-      upper
-
-instance CoArbitrary a => CoArbitrary (Interval a) where
-  coarbitrary int = coarbitrary (lowerBound' int) . coarbitrary (upperBound' int)
-
-instance (Function a, Ord a) => Function (Interval a) where
-  function = functionMap g h
-    where
-      g = lowerBound' &&& upperBound'
-      h = uncurry interval
-
-deriving via (EqEqProp (Interval a)) instance Eq a => (EqProp (Interval a))
-
-instance ToJSON a => ToJSON (Interval a) where
-  toJSON x = Array . fromList $
-    [ object [ lowerKey .= lowerVal ]
-    , object [ upperKey .= upperVal ]
-    ]
-    where
-      (lowerVal, lowerBoundary) = lowerBound' x
-      (upperVal, upperBoundary) = upperBound' x
-      upperKey = boundaryToKey upperBoundary
-      lowerKey = boundaryToKey lowerBoundary
-      boundaryToKey Open = "Excluded"
-      boundaryToKey Closed = "Included"
-
-instance forall a. (FromJSON a, Ord a) => FromJSON (Interval a) where
-  parseJSON x =
-    boundPairWithBoundary x
-      <|> boundPairWithoutBoundary x
-      <|> singleVal x
-    where
-      boundPairWithBoundary = withArray "Bound pair" $ \arr -> do
-        checkLength arr
-        lower <- parseBound $ arr ^?! ix 0
-        upper <- parseBound $ arr ^?! ix 1
-        pure $ interval lower upper
-      parseBound = withObject "Bound" $ \obj -> do
-        when (KM.size obj /= 1) $ fail "Expected an object with a single key"
-        let [(k, v)] = obj ^@.. ifolded
-        boundary <- case k of
-          "Excluded" -> pure Open
-          "Open"     -> pure Open
-          "Included" -> pure Closed
-          "Closed"   -> pure Closed
-          _          -> fail "Invalid boundary specification"
-        val <- parseJSON v
-        pure (val, boundary)
-      boundPairWithoutBoundary = withArray "Bound pair" $ \arr -> do
-        checkLength arr
-        lower <- parseJSON $ arr ^?! ix 0
-        upper <- parseJSON $ arr ^?! ix 1
-        pure $ lower <=..< upper
-      singleVal v = do
-        val <- parseJSON v
-        pure $ val <=..<= val
-      checkLength arr =
-        when (length arr /= 2) $ fail "Expected array of length 2"
-
---------------------------------------------------------------------------------
-
-deriving anyclass instance NFData Graphics.Vty.Input.Key
-deriving anyclass instance NFData Graphics.Vty.Input.Modifier
diff --git a/users/grfn/xanthous/src/Xanthous/Physics.hs b/users/grfn/xanthous/src/Xanthous/Physics.hs
deleted file mode 100644
index 37530cbbc21b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Physics.hs
+++ /dev/null
@@ -1,71 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Physics
-  ( throwDistance
-  , bluntThrowDamage
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Xanthous.Data
-       ( Meters
-       , (:**:)(..)
-       , Square
-       , Grams
-       , (|*|)
-       , (|/|)
-       , Hitpoints
-       , Per (..)
-       , squared
-       , Uno(..), (|+|)
-       )
---------------------------------------------------------------------------------
-
--- university shotputter can put a 16 lb shot about 14 meters
--- ≈ 7.25 kg 14 meters
--- 14m = x / (7.25kg × y + z)²
--- 14m = x / (7250g × y + z)²
---
--- we don't want to scale down too much:
---
--- 10 kg 10 meters
--- = 10000 g 10 meters
---
--- 15 kg w meters
--- = 15000 g w meters
---
--- 14m = x / (7250g × y + z)²
--- 10m = x / (10000g × y + z)²
--- wm = x / (15000g × y + z)²
---
--- w≈0.527301 ∧ y≈0.000212178 sqrt(x) ∧ z≈1.80555 sqrt(x) ∧ 22824.1 sqrt(x)!=0
---
--- x = 101500
--- y = 0.0675979
--- z = 575.231
---
-
--- TODO make this dynamic
-strength :: Meters :**: Square Grams
-strength = Times 10150000
-
-yCoeff :: Uno Double
-yCoeff = Uno 0.0675979
-
-zCoeff :: Uno Double
-zCoeff = Uno 575.231
-
--- | Calculate the maximum distance an object with the given weight can be
--- thrown
-throwDistance
-  :: Grams  -- ^ Weight of the object
-  -> Meters -- ^ Max distance thrown
-throwDistance weight = strength |/| squared (weight |*| yCoeff |+| zCoeff)
-
--- | Returns the damage dealt by a blunt object with the given weight when
--- thrown
-bluntThrowDamage
-  :: Grams
-  -> Hitpoints
-bluntThrowDamage weight = throwDamageRatio |*| weight
-  where
-    throwDamageRatio :: Hitpoints `Per` Grams
-    throwDamageRatio = Rate $ 1 / 5000
diff --git a/users/grfn/xanthous/src/Xanthous/Prelude.hs b/users/grfn/xanthous/src/Xanthous/Prelude.hs
deleted file mode 100644
index 2cb4299303ba..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Prelude.hs
+++ /dev/null
@@ -1,48 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Prelude
-  ( module ClassyPrelude
-  , Type
-  , Constraint
-  , module GHC.TypeLits
-  , module Control.Lens
-  , module Data.Void
-  , module Control.Comonad
-  , module Witherable
-  , fail
-
-  , (&!)
-
-    -- * Classy-Prelude addons
-  , ninsertSet
-  , ndeleteSet
-  , toVector
-  ) where
---------------------------------------------------------------------------------
-import ClassyPrelude hiding
-  ( return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say
-  , catMaybes, filter, mapMaybe, hashNub, ordNub
-  , Memoized, runMemoized
-  )
-import Data.Kind
-import GHC.TypeLits hiding (Text)
-import Control.Lens hiding (levels, Level)
-import Data.Void
-import Control.Comonad
-import Witherable
-import Control.Monad.Fail (fail)
---------------------------------------------------------------------------------
-
-ninsertSet
-  :: (IsSet set, MonoPointed set)
-  => Element set -> NonNull set -> NonNull set
-ninsertSet x xs = impureNonNull $ opoint x `union` toNullable xs
-
-ndeleteSet :: IsSet b => Element b -> NonNull b -> b
-ndeleteSet x = deleteSet x . toNullable
-
-toVector :: (MonoFoldable (f a), Element (f a) ~ a) => f a -> Vector a
-toVector = fromList . toList
-
-infixl 1 &!
-(&!) :: a -> (a -> b) -> b
-(&!) = flip ($!)
diff --git a/users/grfn/xanthous/src/Xanthous/Random.hs b/users/grfn/xanthous/src/Xanthous/Random.hs
deleted file mode 100644
index 329b321b8bda..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Random.hs
+++ /dev/null
@@ -1,186 +0,0 @@
---------------------------------------------------------------------------------
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
---------------------------------------------------------------------------------
-module Xanthous.Random
-  ( Choose(..)
-  , ChooseElement(..)
-  , Weighted(..)
-  , evenlyWeighted
-  , weightedBy
-  , subRand
-  , chance
-  , chooseSubset
-  , chooseRange
-  , FiniteInterval(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.List.NonEmpty (NonEmpty(..))
-import           Control.Monad.Random.Class (MonadRandom(getRandomR, getRandom))
-import           Control.Monad.Random (Rand, evalRand, mkStdGen, StdGen)
-import           Data.Functor.Compose
-import           Data.Random.Shuffle.Weighted
-import           Data.Random.Distribution
-import           Data.Random.Distribution.Uniform
-import           Data.Random.Distribution.Uniform.Exclusive
-import           Data.Random.Sample
-import qualified Data.Random.Source as DRS
-import           Data.Interval ( Interval, lowerBound', Extended (Finite)
-                               , upperBound', Boundary (Closed), lowerBound, upperBound
-                               )
---------------------------------------------------------------------------------
-
-instance {-# INCOHERENT #-} (Monad m, MonadRandom m) => DRS.MonadRandom m where
-  getRandomWord8 = getRandom
-  getRandomWord16 = getRandom
-  getRandomWord32 = getRandom
-  getRandomWord64 = getRandom
-  getRandomDouble = getRandom
-  getRandomNByteInteger n = getRandomR (0, 256 ^ n)
-
-class Choose a where
-  type RandomResult a
-  choose :: MonadRandom m => a -> m (RandomResult a)
-
-newtype ChooseElement a = ChooseElement a
-
-instance MonoFoldable a => Choose (ChooseElement a) where
-  type RandomResult (ChooseElement a) = Maybe (Element a)
-  choose (ChooseElement xs) = do
-    chosenIdx <- getRandomR (0, olength xs - 1)
-    let pick _ (Just x) = Just x
-        pick (x, i) Nothing
-          | i == chosenIdx = Just x
-          | otherwise = Nothing
-    pure $ ofoldr pick Nothing $ zip (toList xs) [0..]
-
-instance MonoFoldable a => Choose (NonNull a) where
-  type RandomResult (NonNull a) = Element a
-  choose
-    = fmap (fromMaybe (error "unreachable")) -- why not lol
-    . choose
-    . ChooseElement
-    . toNullable
-
-instance Choose (NonEmpty a) where
-  type RandomResult (NonEmpty a) = a
-  choose = choose . fromNonEmpty @[_]
-
-instance Choose (a, a) where
-  type RandomResult (a, a) = a
-  choose (x, y) = choose (x :| [y])
-
-newtype Weighted w t a = Weighted (t (w, a))
-  deriving (Functor, Foldable) via (t `Compose` (,) w)
-
-deriving newtype instance Eq (t (w, a)) => Eq (Weighted w t a)
-deriving newtype instance Show (t (w, a)) => Show (Weighted w t a)
-deriving newtype instance NFData (t (w, a)) => NFData (Weighted w t a)
-
-instance Traversable t => Traversable (Weighted w t) where
-  traverse f (Weighted twa) = Weighted <$> (traverse . traverse) f twa
-
-evenlyWeighted :: [a] -> Weighted Int [] a
-evenlyWeighted = Weighted . itoList
-
--- | Weight the elements of some functor by a function. Larger values of 'w' per
--- its 'Ord' instance will be more likely to be generated
-weightedBy :: Functor t => (a -> w) -> t a -> Weighted w t a
-weightedBy weighting xs = Weighted $ (weighting &&& id) <$> xs
-
-instance (Num w, Ord w, Distribution Uniform w, Excludable w)
-       => Choose (Weighted w [] a) where
-  type RandomResult (Weighted w [] a) = Maybe a
-  choose (Weighted ws) = sample $ headMay <$> weightedSample 1 ws
-
-instance (Num w, Ord w, Distribution Uniform w, Excludable w)
-       => Choose (Weighted w NonEmpty a) where
-  type RandomResult (Weighted w NonEmpty a) = a
-  choose (Weighted ws) =
-    sample
-    $ fromMaybe (error "unreachable") . headMay
-    <$> weightedSample 1 (toList ws)
-
-subRand :: MonadRandom m => Rand StdGen a -> m a
-subRand sub = evalRand sub . mkStdGen <$> getRandom
-
--- | Has a @n@ chance of returning 'True'
---
--- eg, chance 0.5 will return 'True' half the time
-chance
-  :: (Num w, Ord w, Distribution Uniform w, Excludable w, MonadRandom m)
-  => w
-  -> m Bool
-chance n = choose $ weightedBy (bool 1 (n * 2)) bools
-
--- | Choose a random subset of *about* @w@ of the elements of the given
--- 'Witherable' structure
-chooseSubset :: ( Num w, Ord w, Distribution Uniform w, Excludable w
-               , Witherable t
-               , MonadRandom m
-               ) => w -> t a -> m (t a)
-chooseSubset = filterA . const . chance
-
--- | Choose a random @n@ in the given interval
-chooseRange
-  :: ( MonadRandom m
-    , Distribution Uniform n
-    , Enum n
-    , Bounded n
-    , Ord n
-    )
-  => Interval n
-  -> m (Maybe n)
-chooseRange int = traverse sample distribution
-  where
-    (lower, lowerBoundary) = lowerBound' int
-    lowerR = case lower of
-      Finite x -> if lowerBoundary == Closed
-                 then x
-                 else succ x
-      _ -> minBound
-    (upper, upperBoundary) = upperBound' int
-    upperR = case upper of
-      Finite x -> if upperBoundary == Closed
-                 then x
-                 else pred x
-      _ -> maxBound
-    distribution
-      | lowerR <= upperR = Just $ Uniform lowerR upperR
-      | otherwise = Nothing
-
-instance ( Distribution Uniform n
-         , Enum n
-         , Bounded n
-         , Ord n
-         )
-         => Choose (Interval n) where
-  type RandomResult (Interval n) = n
-  choose = fmap (fromMaybe $ error "Invalid interval") . chooseRange
-
-newtype FiniteInterval a
-  = FiniteInterval { unwrapFiniteInterval :: (Interval a) }
-
-instance ( Distribution Uniform n
-         , Ord n
-         )
-         => Choose (FiniteInterval n) where
-  type RandomResult (FiniteInterval n) = n
-  -- TODO broken with open/closed right now
-  choose
-    = sample
-    . uncurry Uniform
-    . over both getFinite
-    . (lowerBound &&& upperBound)
-    . unwrapFiniteInterval
-    where
-      getFinite (Finite x) = x
-      getFinite _ = error "Infinite value"
-
---------------------------------------------------------------------------------
-
-bools :: NonEmpty Bool
-bools = True :| [False]
diff --git a/users/grfn/xanthous/src/Xanthous/Util.hs b/users/grfn/xanthous/src/Xanthous/Util.hs
deleted file mode 100644
index f918340f055b..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util.hs
+++ /dev/null
@@ -1,351 +0,0 @@
-{-# LANGUAGE BangPatterns          #-}
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE QuantifiedConstraints #-}
---------------------------------------------------------------------------------
-module Xanthous.Util
-  ( EqEqProp(..)
-  , EqProp(..)
-  , foldlMapM
-  , foldlMapM'
-  , between
-
-  , appendVia
-
-    -- * Foldable
-    -- ** Uniqueness
-    -- *** Predicates on uniqueness
-  , isUniqueOf
-  , isUnique
-    -- *** Removing all duplicate elements in n * log n time
-  , uniqueOf
-  , unique
-    -- *** Removing sequentially duplicate elements in linear time
-  , uniqOf
-  , uniq
-    -- ** Bag sequence algorithms
-  , takeWhileInclusive
-  , smallestNotIn
-  , removeVectorIndex
-  , removeFirst
-  , maximum1
-  , minimum1
-
-    -- * Combinators
-  , times, times_, endoTimes
-
-    -- * State utilities
-  , modifyK, modifyKL, useListOf
-
-    -- * Type-level programming utils
-  , KnownBool(..)
-
-    -- *
-  , AlphaChar(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (foldr)
---------------------------------------------------------------------------------
-import           Test.QuickCheck.Checkers
-import           Data.Foldable (foldr)
-import           Data.Monoid
-import           Data.Proxy
-import qualified Data.Vector as V
-import           Data.Semigroup (Max(..), Min(..))
-import           Data.Semigroup.Foldable
-import           Control.Monad.State.Class
-import           Control.Monad.State (evalState)
---------------------------------------------------------------------------------
-
-newtype EqEqProp a = EqEqProp a
-  deriving newtype Eq
-
-instance Eq a => EqProp (EqEqProp a) where
-  (=-=) = eq
-
-foldlMapM :: forall g b a m. (Foldable g, Monoid b, Applicative m) => (a -> m b) -> g a -> m b
-foldlMapM f = foldr f' (pure mempty)
-  where
-    f' :: a -> m b -> m b
-    f' x = liftA2 mappend (f x)
-
--- Strict in the monoidal accumulator. For monads strict
--- in the left argument of bind, this will run in constant
--- space.
-foldlMapM' :: forall g b a m. (Foldable g, Monoid b, Monad m) => (a -> m b) -> g a -> m b
-foldlMapM' f xs = foldr f' pure xs mempty
-  where
-  f' :: a -> (b -> m b) -> b -> m b
-  f' x k bl = do
-    br <- f x
-    let !b = mappend bl br
-    k b
-
--- | Returns whether the third argument is in the range given by the first two
--- arguments, inclusive
---
--- >>> between (0 :: Int) 2 2
--- True
---
--- >>> between (0 :: Int) 2 3
--- False
-between
-  :: Ord a
-  => a -- ^ lower bound
-  -> a -- ^ upper bound
-  -> a -- ^ scrutinee
-  -> Bool
-between lower upper x = x >= lower && x <= upper
-
--- |
--- >>> appendVia Sum 1 2
--- 3
-appendVia :: (Rewrapping s t, Semigroup s) => (Unwrapped s -> s) -> Unwrapped s -> Unwrapped s -> Unwrapped s
-appendVia wrap x y = op wrap $ wrap x <> wrap y
-
---------------------------------------------------------------------------------
-
--- | Returns True if the targets of the given 'Fold' are unique per the 'Ord' instance for @a@
---
--- >>> isUniqueOf (folded . _1) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)])
--- True
---
--- >>> isUniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2)] :: [(Int, Int)])
--- False
---
--- @
--- 'isUniqueOf' :: Ord a => 'Getter' s a     -> s -> 'Bool'
--- 'isUniqueOf' :: Ord a => 'Fold' s a       -> s -> 'Bool'
--- 'isUniqueOf' :: Ord a => 'Lens'' s a      -> s -> 'Bool'
--- 'isUniqueOf' :: Ord a => 'Iso'' s a       -> s -> 'Bool'
--- 'isUniqueOf' :: Ord a => 'Traversal'' s a -> s -> 'Bool'
--- 'isUniqueOf' :: Ord a => 'Prism'' s a     -> s -> 'Bool'
--- @
-isUniqueOf :: Ord a => Getting (Endo (Set a, Bool)) s a -> s -> Bool
-isUniqueOf aFold = orOf _2 . foldrOf aFold rejectUnique (mempty, True)
- where
-  rejectUnique x (seen, acc)
-    | seen ^. contains x = (seen, False)
-    | otherwise          = (seen & contains x .~ True, acc)
-
--- | Returns true if the given 'Foldable' container contains only unique
--- elements, as determined by the 'Ord' instance for @a@
---
--- >>> isUnique ([3, 1, 2] :: [Int])
--- True
---
--- >>> isUnique ([1, 1, 2, 2, 3, 1] :: [Int])
--- False
-isUnique :: (Foldable f, Ord a) => f a -> Bool
-isUnique = isUniqueOf folded
-
-
--- | O(n * log n). Returns a monoidal, 'Cons'able container (a list, a Set,
--- etc.) consisting of the unique (per the 'Ord' instance for @a@) targets of
--- the given 'Fold'
---
--- >>> uniqueOf (folded . _2) ([(1, 2), (2, 2), (3, 2), (4, 3)] :: [(Int, Int)]) :: [Int]
--- [2,3]
---
--- @
--- 'uniqueOf' :: Ord a => 'Getter' s a     -> s -> [a]
--- 'uniqueOf' :: Ord a => 'Fold' s a       -> s -> [a]
--- 'uniqueOf' :: Ord a => 'Lens'' s a      -> s -> [a]
--- 'uniqueOf' :: Ord a => 'Iso'' s a       -> s -> [a]
--- 'uniqueOf' :: Ord a => 'Traversal'' s a -> s -> [a]
--- 'uniqueOf' :: Ord a => 'Prism'' s a     -> s -> [a]
--- @
-uniqueOf
-  :: (Monoid c, Ord w, Cons c c w w) => Getting (Endo (Set w, c)) a w -> a -> c
-uniqueOf aFold = snd . foldrOf aFold rejectUnique (mempty, mempty)
- where
-  rejectUnique x (seen, acc)
-    | seen ^. contains x = (seen, acc)
-    | otherwise          = (seen & contains x .~ True, cons x acc)
-
--- | Returns a monoidal, 'Cons'able container (a list, a Set, etc.) consisting
--- of the unique (per the 'Ord' instance for @a@) contents of the given
--- 'Foldable' container
---
--- >>> unique [1, 1, 2, 2, 3, 1] :: [Int]
--- [2,3,1]
-
--- >>> unique [1, 1, 2, 2, 3, 1] :: Set Int
--- fromList [3,2,1]
-unique :: (Foldable f, Cons c c a a, Ord a, Monoid c) => f a -> c
-unique = uniqueOf folded
-
---------------------------------------------------------------------------------
-
--- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.)
--- consisting of the targets of the given 'Fold' with sequential duplicate
--- elements removed
---
--- This function (sorry for the confusing name) differs from 'uniqueOf' in that
--- it only compares /sequentially/ duplicate elements (and thus operates in
--- linear time).
--- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name
---
--- >>> uniqOf (folded . _2) ([(1, 2), (2, 2), (3, 1), (4, 2)] :: [(Int, Int)]) :: [Int]
--- [2,1,2]
---
--- @
--- 'uniqOf' :: Eq a => 'Getter' s a     -> s -> [a]
--- 'uniqOf' :: Eq a => 'Fold' s a       -> s -> [a]
--- 'uniqOf' :: Eq a => 'Lens'' s a      -> s -> [a]
--- 'uniqOf' :: Eq a => 'Iso'' s a       -> s -> [a]
--- 'uniqOf' :: Eq a => 'Traversal'' s a -> s -> [a]
--- 'uniqOf' :: Eq a => 'Prism'' s a     -> s -> [a]
--- @
-uniqOf :: (Monoid c, Cons c c w w, Eq w) => Getting (Endo (Maybe w, c)) a w -> a -> c
-uniqOf aFold = snd . foldrOf aFold rejectSeen (Nothing, mempty)
-  where
-    rejectSeen x (Nothing, acc) = (Just x, x <| acc)
-    rejectSeen x tup@(Just a, acc)
-      | x == a     = tup
-      | otherwise = (Just x, x <| acc)
-
--- | O(n). Returns a monoidal, 'Cons'able container (a list, a Vector, etc.)
--- consisting of the targets of the given 'Foldable' container with sequential
--- duplicate elements removed
---
--- This function (sorry for the confusing name) differs from 'unique' in that
--- it only compares /sequentially/ unique elements (and thus operates in linear
--- time).
--- cf 'Data.Vector.uniq' and POSIX @uniq@ for the name
---
--- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: [Int]
--- [1,2,3,1]
---
--- >>> uniq [1, 1, 1, 2, 2, 2, 3, 3, 1] :: Vector Int
--- [1,2,3,1]
---
-uniq :: (Foldable f, Eq a, Cons c c a a, Monoid c) => f a -> c
-uniq = uniqOf folded
-
--- | Like 'takeWhile', but inclusive
-takeWhileInclusive :: (a -> Bool) -> [a] -> [a]
-takeWhileInclusive _ [] = []
-takeWhileInclusive p (x:xs) = x : if p x then takeWhileInclusive p xs else []
-
--- | Returns the smallest value not in a list
-smallestNotIn :: (Ord a, Bounded a, Enum a) => [a] -> a
-smallestNotIn xs = case uniq $ sort xs of
-  [] -> minBound
-  xs'@(x : _)
-    | x > minBound -> minBound
-    | otherwise
-    -> snd . headEx . filter (uncurry (/=)) $ zip (xs' ++ [minBound]) [minBound..]
-
--- | Remove the element at the given index, if any, from the given vector
-removeVectorIndex :: Int -> Vector a -> Vector a
-removeVectorIndex idx vect =
-  let (before, after) = V.splitAt idx vect
-  in before <> fromMaybe Empty (tailMay after)
-
--- | Remove the first element in a sequence that matches a given predicate
-removeFirst :: IsSequence seq => (Element seq -> Bool) -> seq -> seq
-removeFirst p
-  = flip evalState False
-  . filterM (\x -> do
-                found <- get
-                let matches = p x
-                when matches $ put True
-                pure $ found || not matches)
-
-maximum1 :: (Ord a, Foldable1 f) => f a -> a
-maximum1 = getMax . foldMap1 Max
-
-minimum1 :: (Ord a, Foldable1 f) => f a -> a
-minimum1 = getMin . foldMap1 Min
-
-times :: (Applicative f, Num n, Enum n) => n -> (n -> f b) -> f [b]
-times n f = traverse f [1..n]
-
-times_ :: (Applicative f, Num n, Enum n) => n -> f a -> f [a]
-times_ n fa = times n (const fa)
-
--- | Multiply an endomorphism by an integral
---
--- >>> endoTimes (4 :: Int) succ (5 :: Int)
--- 9
-endoTimes :: Integral n => n -> (a -> a) -> a -> a
-endoTimes n f = appEndo $ stimes n (Endo f)
-
---------------------------------------------------------------------------------
-
--- | This class gives a boolean associated with a type-level bool, a'la
--- 'KnownSymbol', 'KnownNat' etc.
-class KnownBool (bool :: Bool) where
-  boolVal' :: forall proxy. proxy bool -> Bool
-  boolVal' _ = boolVal @bool
-
-  boolVal :: Bool
-  boolVal = boolVal' $ Proxy @bool
-
-instance KnownBool 'True where boolVal = True
-instance KnownBool 'False where boolVal = False
-
---------------------------------------------------------------------------------
-
--- | Modify some monadic state via the application of a kleisli endomorphism on
--- the state itself
---
--- Note that any changes made to the state during execution of @k@ will be
--- overwritten
---
--- @@
--- modifyK pure === pure ()
--- @@
-modifyK :: MonadState s m => (s -> m s) -> m ()
-modifyK k = get >>= k >>= put
-
--- | Modify some monadic state via the application of a kleisli endomorphism on
--- the target of a lens
---
--- Note that any changes made to the state during execution of @k@ will be
--- overwritten
---
--- @@
--- modifyKL id pure === pure ()
--- @@
-modifyKL :: MonadState s m => LensLike m s s a b -> (a -> m b) -> m ()
-modifyKL l k = get >>= traverseOf l k >>= put
-
--- | Use a list of all the targets of a 'Fold' in the current state
---
--- @@
--- evalState (useListOf folded) === toList
--- @@
-useListOf :: MonadState s m => Getting (Endo [a]) s a -> m [a]
-useListOf = gets . toListOf
-
---------------------------------------------------------------------------------
-
--- | A newtype wrapper around 'Char' whose 'Enum' and 'Bounded' instances only
--- include the characters @[a-zA-Z]@
---
--- >>> succ (AlphaChar 'z')
--- 'A'
-newtype AlphaChar = AlphaChar { getAlphaChar :: Char }
-  deriving stock Show
-  deriving (Eq, Ord) via Char
-
-instance Enum AlphaChar where
-  toEnum n
-    | between 0 25 n
-    = AlphaChar . toEnum $ n + fromEnum 'a'
-    | between 26 51 n
-    = AlphaChar . toEnum $ n - 26 + fromEnum 'A'
-    | otherwise
-    = error $ "Tag " <> show n <> " out of range [0, 51] for enum AlphaChar"
-  fromEnum (AlphaChar chr)
-    | between 'a' 'z' chr
-    = fromEnum chr - fromEnum 'a'
-    | between 'A' 'Z' chr
-    = fromEnum chr - fromEnum 'A'
-    | otherwise
-    = error $ "Invalid value for alpha char: " <> show chr
-
-instance Bounded AlphaChar where
-  minBound = AlphaChar 'a'
-  maxBound = AlphaChar 'Z'
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs b/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs
deleted file mode 100644
index 9e158cc8e2d4..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Comonad.hs
+++ /dev/null
@@ -1,24 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Comonad
-  ( -- * Store comonad utils
-    replace
-  , current
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Control.Comonad.Store.Class
---------------------------------------------------------------------------------
-
--- | Replace the current position of a store comonad with a new value by
--- comparing positions
-replace :: (Eq i, ComonadStore i w) => w a -> a -> w a
-replace w x = w =>> \w' -> if pos w' == pos w then x else extract w'
-{-# INLINE replace #-}
-
--- | Lens into the current position of a store comonad.
---
---     current = lens extract replace
-current :: (Eq i, ComonadStore i w) => Lens' (w a) a
-current = lens extract replace
-{-# INLINE current #-}
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graph.hs b/users/grfn/xanthous/src/Xanthous/Util/Graph.hs
deleted file mode 100644
index 8e5c04f4bfa9..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Graph.hs
+++ /dev/null
@@ -1,33 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Graph where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Graph.Inductive.Query.MST (msTree)
-import qualified Data.Graph.Inductive.Graph as Graph
-import           Data.Graph.Inductive.Graph
-import           Data.Graph.Inductive.Basic (undir)
-import           Data.Set (isSubsetOf)
---------------------------------------------------------------------------------
-
-mstSubGraph
-  :: forall gr node edge. (DynGraph gr, Real edge, Show edge)
-  => gr node edge -> gr node edge
-mstSubGraph graph = insEdges mstEdges . insNodes (labNodes graph) $ Graph.empty
-  where
-    mstEdges = ordNub $ do
-      LP path <- msTree $ undir graph
-      case path of
-        [] -> []
-        [_] -> []
-        ((n₂, edgeWeight) : (n₁, _) : _) ->
-          pure (n₁, n₂, edgeWeight)
-
-isSubGraphOf
-  :: (Graph gr1, Graph gr2, Ord node, Ord edge)
-  => gr1 node edge
-  -> gr2 node edge
-  -> Bool
-isSubGraphOf graph₁ graph₂
-  = setFromList (labNodes graph₁) `isSubsetOf` setFromList (labNodes graph₂)
-  && setFromList (labEdges graph₁) `isSubsetOf` setFromList (labEdges graph₂)
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs
deleted file mode 100644
index 0cb009f45ad0..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Graphics.hs
+++ /dev/null
@@ -1,177 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
--- | Graphics algorithms and utils for rendering things in 2D space
---------------------------------------------------------------------------------
-module Xanthous.Util.Graphics
-  ( circle
-  , filledCircle
-  , line
-  , straightLine
-  , delaunay
-
-    -- * Debugging and testing tools
-  , renderBooleanGraphics
-  , showBooleanGraphics
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
--- https://github.com/noinia/hgeometry/issues/28
--- import qualified Algorithms.Geometry.DelaunayTriangulation.DivideAndConquer
---               as Geometry
-import qualified Algorithms.Geometry.DelaunayTriangulation.Naive
-              as Geometry
-import qualified Algorithms.Geometry.DelaunayTriangulation.Types as Geometry
-import           Control.Monad.State (execState, State)
-import qualified Data.Geometry.Point as Geometry
-import           Data.Ext ((:+)(..))
-import           Data.List (unfoldr)
-import           Data.List.NonEmpty (NonEmpty((:|)))
-import qualified Data.List.NonEmpty as NE
-import           Data.Ix (Ix)
-import           Linear.V2
---------------------------------------------------------------------------------
-
-
--- | Generate a circle centered at the given point and with the given radius
--- using the <midpoint circle algorithm
--- https://en.wikipedia.org/wiki/Midpoint_circle_algorithm>.
---
--- Code taken from <https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#Haskell>
-circle :: (Num i, Ord i)
-       => V2 i -- ^ center
-       -> i    -- ^ radius
-       -> [V2 i]
-circle (V2 x₀ y₀) radius
-  -- Four initial points, plus the generated points
-  = V2 x₀ (y₀ + radius)
-  : V2 x₀ (y₀ - radius)
-  : V2 (x₀ + radius) y₀
-  : V2 (x₀ - radius) y₀
-  : points
-    where
-      -- Creates the (x, y) octet offsets, then maps them to absolute points in all octets.
-      points = concatMap generatePoints $ unfoldr step initialValues
-
-      generatePoints (V2 x y)
-        = [ V2 (x₀ `xop` x') (y₀ `yop` y')
-          | (x', y') <- [(x, y), (y, x)]
-          , xop <- [(+), (-)]
-          , yop <- [(+), (-)]
-          ]
-
-      initialValues = (1 - radius, 1, (-2) * radius, 0, radius)
-
-      step (f, ddf_x, ddf_y, x, y)
-        | x >= y = Nothing
-        | otherwise = Just (V2 x' y', (f', ddf_x', ddf_y', x', y'))
-        where
-          (f', ddf_y', y') | f >= 0 = (f + ddf_y' + ddf_x', ddf_y + 2, y - 1)
-                           | otherwise = (f + ddf_x, ddf_y, y)
-          ddf_x' = ddf_x + 2
-          x' = x + 1
-
-
-data FillState i
-  = FillState
-  { _inCircle :: Bool
-  , _result :: NonEmpty (V2 i)
-  }
-makeLenses ''FillState
-
-runFillState :: NonEmpty (V2 i) -> State (FillState i) a -> [V2 i]
-runFillState circumference s
-  = toList
-  . view result
-  . execState s
-  $ FillState False circumference
-
--- | Generate a *filled* circle centered at the given point and with the given
--- radius by filling a circle generated with 'circle'
-filledCircle :: (Num i, Integral i, Ix i)
-             => V2 i -- ^ center
-             -> i    -- ^ radius
-             -> [V2 i]
-filledCircle center radius =
-  case NE.nonEmpty (circle center radius) of
-    Nothing -> []
-    Just circumference -> runFillState circumference $
-      -- the first and last lines of all circles are solid, so the whole "in the
-      -- circle, out of the circle" thing doesn't work... but that's fine since
-      -- we don't need to fill them. So just skip them
-      for_ [succ minX..pred maxX] $ \x ->
-        for_ [minY..maxY] $ \y -> do
-          let pt = V2 x y
-              next = V2 x $ succ y
-          whenM (use inCircle) $ result %= NE.cons pt
-
-          when (pt `elem` circumference && next `notElem` circumference)
-            $ inCircle %= not
-
-      where
-        (V2 minX minY, V2 maxX maxY) = minmaxes circumference
-
--- | Draw a line between two points using Bresenham's line drawing algorithm
---
--- Code taken from <https://wiki.haskell.org/Bresenham%27s_line_drawing_algorithm>
-line :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
-line pa@(V2 xa ya) pb@(V2 xb yb)
-  = (if maySwitch pa < maySwitch pb then id else reverse) points
-  where
-    points               = map maySwitch . unfoldr go $ (x₁, y₁, 0)
-    steep                = abs (yb - ya) > abs (xb - xa)
-    maySwitch            = if steep then view _yx else id
-    [V2 x₁ y₁, V2 x₂ y₂] = sort [maySwitch pa, maySwitch pb]
-    δx                   = x₂ - x₁
-    δy                   = abs (y₂ - y₁)
-    ystep                = if y₁ < y₂ then 1 else -1
-    go (xTemp, yTemp, err)
-      | xTemp > x₂ = Nothing
-      | otherwise  = Just (V2 xTemp yTemp, (xTemp + 1, newY, newError))
-      where
-        tempError        = err + δy
-        (newY, newError) = if (2 * tempError) >= δx
-                           then (yTemp + ystep, tempError - δx)
-                           else (yTemp, tempError)
-{-# SPECIALIZE line :: V2 Int -> V2 Int -> [V2 Int] #-}
-{-# SPECIALIZE line :: V2 Word -> V2 Word -> [V2 Word] #-}
-
-straightLine :: (Num i, Ord i) => V2 i -> V2 i -> [V2 i]
-straightLine pa@(V2 xa _) pb@(V2 _ yb) = line pa midpoint ++ line midpoint pb
-  where midpoint = V2 xa yb
-
-delaunay
-  :: (Ord n, Fractional n)
-  => NonEmpty (V2 n, p)
-  -> [((V2 n, p), (V2 n, p))]
-delaunay
-  = map (over both fromPoint)
-  . Geometry.edgesAsPoints
-  . Geometry.delaunayTriangulation
-  . map toPoint
-  where
-    toPoint (V2 px py, pid) = Geometry.Point2 px py :+ pid
-    fromPoint (Geometry.Point2 px py :+ pid) = (V2 px py, pid)
-
---------------------------------------------------------------------------------
-
-renderBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> String
-renderBooleanGraphics [] = ""
-renderBooleanGraphics (pt : pts') = intercalate "\n" rows
-  where
-    rows = row <$> [minX..maxX]
-    row x = [minY..maxY] <&> \y -> if V2 x y `member` ptSet then 'X' else ' '
-    (V2 minX minY, V2 maxX maxY) = minmaxes pts
-    pts = pt :| pts'
-    ptSet :: Set (V2 i)
-    ptSet = setFromList $ toList pts
-
-showBooleanGraphics :: forall i. (Num i, Ord i, Enum i) => [V2 i] -> IO ()
-showBooleanGraphics = putStrLn . pack . renderBooleanGraphics
-
-minmaxes :: forall i. (Ord i) => NonEmpty (V2 i) -> (V2 i, V2 i)
-minmaxes xs =
-  ( V2 (minimum1Of (traverse1 . _x) xs)
-       (minimum1Of (traverse1 . _y) xs)
-  , V2 (maximum1Of (traverse1 . _x) xs)
-       (maximum1Of (traverse1 . _y) xs)
-  )
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs b/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs
deleted file mode 100644
index 724f2339dd21..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Inflection.hs
+++ /dev/null
@@ -1,14 +0,0 @@
-
-module Xanthous.Util.Inflection
-  ( toSentence
-  ) where
-
-import Xanthous.Prelude
-
-toSentence :: (MonoFoldable mono, Element mono ~ Text) => mono -> Text
-toSentence xs = case reverse . toList $ xs of
-  [] -> ""
-  [x] -> x
-  [b, a] -> a <> " and " <> b
-  (final : butlast) ->
-    intercalate ", " (reverse butlast) <> ", and " <> final
diff --git a/users/grfn/xanthous/src/Xanthous/Util/JSON.hs b/users/grfn/xanthous/src/Xanthous/Util/JSON.hs
deleted file mode 100644
index 91d1328e4a10..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/JSON.hs
+++ /dev/null
@@ -1,19 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.JSON
-  ( ReadShowJSON(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Data.Aeson
---------------------------------------------------------------------------------
-
-newtype ReadShowJSON a = ReadShowJSON a
-  deriving newtype (Read, Show)
-
-instance Show a => ToJSON (ReadShowJSON a) where
-  toJSON = toJSON . show
-
-instance Read a => FromJSON (ReadShowJSON a) where
-  parseJSON = withText "readable"
-    $ maybe (fail "Could not read") pure . readMay
diff --git a/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs b/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs
deleted file mode 100644
index dfa65372351d..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/Optparse.hs
+++ /dev/null
@@ -1,21 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Util.Optparse
-  ( readWithGuard
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import qualified Options.Applicative as Opt
---------------------------------------------------------------------------------
-
-readWithGuard
-  :: Read b
-  => (b -> Bool)
-  -> (b -> String)
-  -> Opt.ReadM b
-readWithGuard predicate errmsg = do
-  res <- Opt.auto
-  unless (predicate res)
-    $ Opt.readerError
-    $ errmsg res
-  pure res
diff --git a/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs b/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs
deleted file mode 100644
index aa881b322779..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Util/QuickCheck.hs
+++ /dev/null
@@ -1,32 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-module Xanthous.Util.QuickCheck
-  ( functionShow
-  , FunctionShow(..)
-  , functionJSON
-  , FunctionJSON(..)
-  , genericArbitrary
-  , GenericArbitrary(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Test.QuickCheck
-import Test.QuickCheck.Function
-import Test.QuickCheck.Instances.ByteString ()
-import Test.QuickCheck.Arbitrary.Generic
-import Data.Aeson
---------------------------------------------------------------------------------
-
-newtype FunctionShow a = FunctionShow a
-  deriving newtype (Show, Read)
-
-instance (Show a, Read a) => Function (FunctionShow a) where
-  function = functionShow
-
-functionJSON :: (ToJSON a, FromJSON a) => (a -> c) -> a :-> c
-functionJSON = functionMap encode (headEx . decode)
-
-newtype FunctionJSON a = FunctionJSON a
-  deriving newtype (ToJSON, FromJSON)
-
-instance (ToJSON a, FromJSON a) => Function (FunctionJSON a) where
-  function = functionJSON
diff --git a/users/grfn/xanthous/src/Xanthous/keybindings.yaml b/users/grfn/xanthous/src/Xanthous/keybindings.yaml
deleted file mode 100644
index cffb27cb03f6..000000000000
--- a/users/grfn/xanthous/src/Xanthous/keybindings.yaml
+++ /dev/null
@@ -1,22 +0,0 @@
-q: Quit
-?: Help
-.: Wait
-C-p: PreviousMessage
-',': PickUp
-d: Drop
-o: Open
-c: Close
-;: Look
-e: Eat
-S: Save
-r: Read
-i: ShowInventory
-I: DescribeInventory
-w: Wield
-f: Fire
-'<': GoUp
-'>': GoDown
-R: Rest
-
-# Debug commands
-M-r: ToggleRevealAll
diff --git a/users/grfn/xanthous/src/Xanthous/messages.yaml b/users/grfn/xanthous/src/Xanthous/messages.yaml
deleted file mode 100644
index bc08ec1ad24d..000000000000
--- a/users/grfn/xanthous/src/Xanthous/messages.yaml
+++ /dev/null
@@ -1,161 +0,0 @@
-welcome: Welcome to Xanthous, {{characterName}}! It's dangerous out there, why not stay inside? Press ? for help.
-dead:
-  - You have died...
-  - You die...
-  - You perish...
-  - You have perished...
-
-generic:
-  continue: Press enter to continue...
-
-save:
-  disabled: "Sorry, saving is currently disabled"
-  location: "Enter filename to save to: "
-  overwrite: "A file named {{filename}} already exists. Would you like to overwrite it? "
-
-quit:
-  confirm: Really quit without saving?
-
-entities:
-  description: You see here {{entityDescriptions}}
-  say:
-    creature:
-      visible: The {{creature.creatureType.name}} {{creature.creatureType.sayVerb}} "{{message}}"
-      invisible: You hear something yell "{{message}}" in the distance
-
-pickUp:
-  menu: What would you like to pick up?
-  pickUp: You pick up the {{item.itemType.name}}.
-  nothingToPickUp: "There's nothing here to pick up"
-
-cant:
-  goUp:
-    - You can't go up here
-    - There's nothing here that would let you go up
-  goDown:
-    - You can't go down here
-    - There's nothing here that would let you go down
-
-open:
-  prompt: Direction to open (hjklybnu.)?
-  success: "You open the door."
-  locked: "That door is locked"
-  nothingToOpen: "There's nothing to open there."
-  alreadyOpen: "That door is already open."
-
-close:
-  prompt: Direction to close (hjklybnu.)?
-  success:
-    - You close the door.
-    - You shut the door.
-  nothingToClose: "There's nothing to close there."
-  alreadyClosed: "That door is already closed."
-  blocked: "The {{entityDescriptions}} {{blockOrBlocks}} the door!"
-
-look:
-  prompt: Select a position on the map to describe (use Enter to confirm)
-  nothing: There's nothing there
-
-character:
-  namePrompt: "What's your name? "
-  body:
-    knuckles:
-      calluses:
-      - You've started developing calluses on your knuckles from all the punching you've been doing.
-      - You've been fighting with your fists so much they're starting to develop calluses.
-
-combat:
-  nothingToAttack: There's nothing to attack there.
-  menu: Which creature would you like to attack?
-  fistSelfDamage:
-    - You hit so hard with your fists you hurt yourself!
-    - The punch leaves your knuckles bloody!
-  fistExtraSelfDamage:
-    - You hurt your already-bloody fists with the strike!
-    - Ouch! Your fists were already bleeding!
-  hit:
-    fists:
-      - You punch the {{creature.creatureType.name}} with your bare fists! It hurts. A lot.
-      - You strike the {{creature.creatureType.name}} with your bare fists! It leaves a bit of a bruise on your knuckles.
-    generic:
-      - You hit the {{creature.creatureType.name}}.
-      - You attack the {{creature.creatureType.name}}.
-  creatureAttack:
-    natural: The {{creature.creatureType.name}} {{attackDescription}}.
-    genericWeapon: The {{creature.creatureType.name}} attacks you with its {{item.itemType.name}}.
-  killed:
-    - You kill the {{creature.creatureType.name}}!
-    - You've killed the {{creature.creatureType.name}}!
-
-debug:
-  toggleRevealAll: revealAll now set to {{revealAll}}
-
-eat:
-  noFood:
-    - You have nothing edible.
-    - You don't have any food.
-    - You don't have anything to eat.
-    - You search your pockets for something edible, and come up short.
-  menuPrompt: What would you like to eat?
-  eat: You eat the {{item.itemType.name}}.
-
-read:
-  prompt: Direction to read (hjklybnu.)?
-  nothing: "There's nothing there to read"
-  result: "\"{{message}}\""
-
-inventory:
-  describe:
-    select: Select an item in your inventory to describe
-    nothing: You aren't carrying anything
-
-wield:
-  nothing:
-    - You aren't carrying anything you can wield
-    - You can't wield anything in your backpack
-    - You can't wield anything currently in your backpack
-  menu: What would you like to wield?
-  hand: Wield in which hand?
-  wielded: You wield the {{item.wieldedItem.itemType.name}} in {{hand}}
-
-fire:
-  nothing:
-    - You don't currently have anything you can throw
-    - You don't have anything to throw
-  zeroRange:
-    - That item is too heavy to throw!
-    - That's too heavy to throw
-    - You're not strong enough to throw that any meaningful distance
-  menu: What would you like to throw?
-  target: Choose a target
-  atRange:
-    - It's too heavy for you to throw any further than this
-  fired:
-    noTarget:
-      - You throw the {{item.itemType.name}} at the ground
-    noDamage:
-      - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to care.
-      - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to do anything.
-      - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It doesn't seem to hurt it.
-    someDamage:
-      - You throw the {{item.itemType.name}} at the {{creature.creatureType.name}}. It hits it on the head!.
-
-drop:
-  nothing: You aren't carrying anything
-  menu: What would you like to drop?
-  # TODO: use actual hands
-  dropped:
-    - You drop the {{item.itemType.name}}.
-    - You drop the {{item.itemType.name}} on the ground.
-    - You put the {{item.itemType.name}} on the ground.
-    - You take the {{item.itemType.name}} out of your backpack and put it on the ground.
-    - You take the {{item.itemType.name}} out of your backpack and drop it on the ground.
-
-autocommands:
-  enemyInSight: There's a {{firstEntity.creatureType.name}} nearby!
-  resting: Resting...
-  doneResting: Done resting
-###
-
-tutorial:
-  message1: The caves are dark and full of nightmarish creatures - and you are likely to perish without food. Seek out sustenance! You can pick items up with ,.
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'
-    ]
-  ]
diff --git a/users/grfn/xanthous/xanthous.cabal b/users/grfn/xanthous/xanthous.cabal
deleted file mode 100644
index 12222c26732f..000000000000
--- a/users/grfn/xanthous/xanthous.cabal
+++ /dev/null
@@ -1,529 +0,0 @@
-cabal-version: 1.12
-
--- This file has been generated from package.yaml by hpack version 0.35.0.
---
--- see: https://github.com/sol/hpack
---
--- hash: b3bf8e65d621856081832c9d3c8e8ad38799e23a7f5084dc4f972daa654a0ff3
-
-name:           xanthous
-version:        0.1.0.0
-synopsis:       A WIP TUI RPG
-description:    Please see the README on GitHub at <https://github.com/glittershark/xanthous>
-category:       Game
-homepage:       https://github.com/glittershark/xanthous#readme
-bug-reports:    https://github.com/glittershark/xanthous/issues
-author:         Griffin Smith
-maintainer:     root@gws.fyi
-copyright:      2019 Griffin Smith
-license:        GPL-3
-license-file:   LICENSE
-build-type:     Simple
-extra-source-files:
-    README.org
-
-source-repository head
-  type: git
-  location: https://github.com/glittershark/xanthous
-
-library
-  exposed-modules:
-      Data.Aeson.Generic.DerivingVia
-      Xanthous.AI.Gormlak
-      Xanthous.App
-      Xanthous.App.Autocommands
-      Xanthous.App.Common
-      Xanthous.App.Prompt
-      Xanthous.App.Time
-      Xanthous.Command
-      Xanthous.Data
-      Xanthous.Data.App
-      Xanthous.Data.Entities
-      Xanthous.Data.EntityChar
-      Xanthous.Data.EntityMap
-      Xanthous.Data.EntityMap.Graphics
-      Xanthous.Data.Levels
-      Xanthous.Data.Memo
-      Xanthous.Data.NestedMap
-      Xanthous.Data.VectorBag
-      Xanthous.Entities.Character
-      Xanthous.Entities.Common
-      Xanthous.Entities.Creature
-      Xanthous.Entities.Creature.Hippocampus
-      Xanthous.Entities.Draw.Util
-      Xanthous.Entities.Entities
-      Xanthous.Entities.Environment
-      Xanthous.Entities.Item
-      Xanthous.Entities.Marker
-      Xanthous.Entities.Raws
-      Xanthous.Entities.RawTypes
-      Xanthous.Game
-      Xanthous.Game.Arbitrary
-      Xanthous.Game.Draw
-      Xanthous.Game.Env
-      Xanthous.Game.Lenses
-      Xanthous.Game.Memo
-      Xanthous.Game.Prompt
-      Xanthous.Game.State
-      Xanthous.Generators.Level
-      Xanthous.Generators.Level.CaveAutomata
-      Xanthous.Generators.Level.Dungeon
-      Xanthous.Generators.Level.LevelContents
-      Xanthous.Generators.Level.Util
-      Xanthous.Generators.Level.Village
-      Xanthous.Generators.Speech
-      Xanthous.Messages
-      Xanthous.Messages.Template
-      Xanthous.Monad
-      Xanthous.Orphans
-      Xanthous.Physics
-      Xanthous.Prelude
-      Xanthous.Random
-      Xanthous.Util
-      Xanthous.Util.Comonad
-      Xanthous.Util.Graph
-      Xanthous.Util.Graphics
-      Xanthous.Util.Inflection
-      Xanthous.Util.JSON
-      Xanthous.Util.Optparse
-      Xanthous.Util.QuickCheck
-  other-modules:
-      Paths_xanthous
-  hs-source-dirs:
-      src
-  default-extensions:
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveGeneric
-      DerivingStrategies
-      DerivingVia
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTSyntax
-      GeneralizedNewtypeDeriving
-      KindSignatures
-      StandaloneKindSignatures
-      LambdaCase
-      MultiWayIf
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-      ViewPatterns
-  ghc-options: -Wall -fconstraint-solver-iterations=6
-  build-depends:
-      JuicyPixels
-    , MonadRandom
-    , QuickCheck
-    , Rasterific
-    , aeson
-    , array
-    , async
-    , base
-    , bifunctors
-    , brick
-    , checkers
-    , classy-prelude
-    , comonad
-    , comonad-extras
-    , constraints
-    , containers
-    , criterion
-    , data-default
-    , data-interval
-    , deepseq
-    , directory
-    , fgl
-    , fgl-arbitrary
-    , file-embed
-    , filepath
-    , generic-arbitrary
-    , generic-lens
-    , groups
-    , hgeometry
-    , hgeometry-combinatorial
-    , lens
-    , lifted-async
-    , linear
-    , megaparsec
-    , mmorph
-    , monad-control
-    , mtl
-    , optparse-applicative
-    , parallel
-    , parser-combinators
-    , pointed
-    , quickcheck-instances
-    , quickcheck-text
-    , random
-    , random-extras
-    , random-fu
-    , random-source
-    , raw-strings-qq
-    , reflection
-    , semigroupoids
-    , semigroups
-    , splitmix
-    , stache
-    , streams
-    , text
-    , text-zipper
-    , tomland
-    , transformers
-    , vector
-    , vty
-    , witherable
-    , yaml
-    , zlib
-  default-language: Haskell2010
-
-executable xanthous
-  main-is: Main.hs
-  other-modules:
-      Paths_xanthous
-  hs-source-dirs:
-      app
-  default-extensions:
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveGeneric
-      DerivingStrategies
-      DerivingVia
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTSyntax
-      GeneralizedNewtypeDeriving
-      KindSignatures
-      StandaloneKindSignatures
-      LambdaCase
-      MultiWayIf
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-      ViewPatterns
-  ghc-options: -Wall -fconstraint-solver-iterations=6 -threaded -rtsopts -with-rtsopts=-N -O2
-  build-depends:
-      JuicyPixels
-    , MonadRandom
-    , QuickCheck
-    , Rasterific
-    , aeson
-    , array
-    , async
-    , base
-    , bifunctors
-    , brick
-    , checkers
-    , classy-prelude
-    , comonad
-    , comonad-extras
-    , constraints
-    , containers
-    , criterion
-    , data-default
-    , data-interval
-    , deepseq
-    , directory
-    , fgl
-    , fgl-arbitrary
-    , file-embed
-    , filepath
-    , generic-arbitrary
-    , generic-lens
-    , groups
-    , hgeometry
-    , hgeometry-combinatorial
-    , lens
-    , lifted-async
-    , linear
-    , megaparsec
-    , mmorph
-    , monad-control
-    , mtl
-    , optparse-applicative
-    , parallel
-    , parser-combinators
-    , pointed
-    , quickcheck-instances
-    , quickcheck-text
-    , random
-    , random-extras
-    , random-fu
-    , random-source
-    , raw-strings-qq
-    , reflection
-    , semigroupoids
-    , semigroups
-    , splitmix
-    , stache
-    , streams
-    , text
-    , text-zipper
-    , tomland
-    , transformers
-    , vector
-    , vty
-    , witherable
-    , xanthous
-    , yaml
-    , zlib
-  default-language: Haskell2010
-
-test-suite test
-  type: exitcode-stdio-1.0
-  main-is: Spec.hs
-  other-modules:
-      Test.Prelude
-      Xanthous.CommandSpec
-      Xanthous.Data.EntitiesSpec
-      Xanthous.Data.EntityCharSpec
-      Xanthous.Data.EntityMap.GraphicsSpec
-      Xanthous.Data.EntityMapSpec
-      Xanthous.Data.LevelsSpec
-      Xanthous.Data.MemoSpec
-      Xanthous.Data.NestedMapSpec
-      Xanthous.DataSpec
-      Xanthous.Entities.CharacterSpec
-      Xanthous.Entities.CommonSpec
-      Xanthous.Entities.RawsSpec
-      Xanthous.Entities.RawTypesSpec
-      Xanthous.Game.PromptSpec
-      Xanthous.Game.StateSpec
-      Xanthous.GameSpec
-      Xanthous.Generators.Level.UtilSpec
-      Xanthous.Messages.TemplateSpec
-      Xanthous.MessageSpec
-      Xanthous.OrphansSpec
-      Xanthous.RandomSpec
-      Xanthous.Util.GraphicsSpec
-      Xanthous.Util.GraphSpec
-      Xanthous.Util.InflectionSpec
-      Xanthous.UtilSpec
-      Paths_xanthous
-  hs-source-dirs:
-      test
-  default-extensions:
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveGeneric
-      DerivingStrategies
-      DerivingVia
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTSyntax
-      GeneralizedNewtypeDeriving
-      KindSignatures
-      StandaloneKindSignatures
-      LambdaCase
-      MultiWayIf
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-      ViewPatterns
-  ghc-options: -Wall -fconstraint-solver-iterations=6 -threaded -rtsopts -with-rtsopts=-N -O0
-  build-depends:
-      JuicyPixels
-    , MonadRandom
-    , QuickCheck
-    , Rasterific
-    , aeson
-    , array
-    , async
-    , base
-    , bifunctors
-    , brick
-    , checkers
-    , classy-prelude
-    , comonad
-    , comonad-extras
-    , constraints
-    , containers
-    , criterion
-    , data-default
-    , data-interval
-    , deepseq
-    , directory
-    , fgl
-    , fgl-arbitrary
-    , file-embed
-    , filepath
-    , generic-arbitrary
-    , generic-lens
-    , groups
-    , hgeometry
-    , hgeometry-combinatorial
-    , lens
-    , lens-properties
-    , lifted-async
-    , linear
-    , megaparsec
-    , mmorph
-    , monad-control
-    , mtl
-    , optparse-applicative
-    , parallel
-    , parser-combinators
-    , pointed
-    , quickcheck-instances
-    , quickcheck-text
-    , random
-    , random-extras
-    , random-fu
-    , random-source
-    , raw-strings-qq
-    , reflection
-    , semigroupoids
-    , semigroups
-    , splitmix
-    , stache
-    , streams
-    , tasty
-    , tasty-hunit
-    , tasty-quickcheck
-    , tasty-rerun
-    , text
-    , text-zipper
-    , tomland
-    , transformers
-    , vector
-    , vty
-    , witherable
-    , xanthous
-    , yaml
-    , zlib
-  default-language: Haskell2010
-
-benchmark benchmark
-  type: exitcode-stdio-1.0
-  main-is: Bench.hs
-  other-modules:
-      Bench.Prelude
-      Xanthous.Generators.UtilBench
-      Xanthous.RandomBench
-      Paths_xanthous
-  hs-source-dirs:
-      bench
-  default-extensions:
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveGeneric
-      DerivingStrategies
-      DerivingVia
-      FlexibleContexts
-      FlexibleInstances
-      FunctionalDependencies
-      GADTSyntax
-      GeneralizedNewtypeDeriving
-      KindSignatures
-      StandaloneKindSignatures
-      LambdaCase
-      MultiWayIf
-      NoImplicitPrelude
-      NoStarIsType
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      ScopedTypeVariables
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-      ViewPatterns
-  ghc-options: -Wall -fconstraint-solver-iterations=6 -threaded -rtsopts -with-rtsopts=-N
-  build-depends:
-      JuicyPixels
-    , MonadRandom
-    , QuickCheck
-    , Rasterific
-    , aeson
-    , array
-    , async
-    , base
-    , bifunctors
-    , brick
-    , checkers
-    , classy-prelude
-    , comonad
-    , comonad-extras
-    , constraints
-    , containers
-    , criterion
-    , data-default
-    , data-interval
-    , deepseq
-    , directory
-    , fgl
-    , fgl-arbitrary
-    , file-embed
-    , filepath
-    , generic-arbitrary
-    , generic-lens
-    , groups
-    , hgeometry
-    , hgeometry-combinatorial
-    , lens
-    , lifted-async
-    , linear
-    , megaparsec
-    , mmorph
-    , monad-control
-    , mtl
-    , optparse-applicative
-    , parallel
-    , parser-combinators
-    , pointed
-    , quickcheck-instances
-    , quickcheck-text
-    , random
-    , random-extras
-    , random-fu
-    , random-source
-    , raw-strings-qq
-    , reflection
-    , semigroupoids
-    , semigroups
-    , splitmix
-    , stache
-    , streams
-    , text
-    , text-zipper
-    , tomland
-    , transformers
-    , vector
-    , vty
-    , witherable
-    , xanthous
-    , yaml
-    , zlib
-  default-language: Haskell2010