Add support for multiple levels

Add a data structure, based on the zipper comonad, which provides
support for multiple levels, each of which is its own entity map. The
current level is provided by coreturn, which the `entities` lens has
been updated to use. Nothing currently supports going up or down levels
yet - that's coming next.

11 files changed, 397 insertions, 14 deletions

diff --git a/build/update-comonad-extras.patch b/build/update-comonad-extras.patch
new file mode 100644
index 000000000000..cd1dbe24d361
--- /dev/null
+++ b/build/update-comonad-extras.patch
@@ -0,0 +1,92 @@
+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/haskell-overlay.nix b/haskell-overlay.nix
index d3775316ad36..fff1c2174179 100644
--- a/haskell-overlay.nix
+++ b/haskell-overlay.nix
@@ -29,4 +29,7 @@ in self: super: with pkgs.haskell.lib; rec {
       };
       version = "0.12.0";
     };
+
+  comonad-extras = appendPatch (markUnbroken super.comonad-extras)
+    [ ./build/update-comonad-extras.patch ];
 }
diff --git a/package.yaml b/package.yaml
index 8d761b58e055..d639e555c741 100644
--- a/package.yaml
+++ b/package.yaml
@@ -26,6 +26,7 @@ dependencies:
 - checkers
 - classy-prelude
 - comonad
+- comonad-extras
 - constraints
 - containers
 - data-default
@@ -48,6 +49,7 @@ dependencies:
 - MonadRandom
 - mtl
 - optparse-applicative
+- pointed
 - random
 - random-fu
 - random-extras
@@ -59,6 +61,7 @@ dependencies:
 - stache
 - semigroupoids
 - tomland
+- text
 - text-zipper
 - vector
 - vty
diff --git a/src/Xanthous/Data/Levels.hs b/src/Xanthous/Data/Levels.hs
new file mode 100644
index 000000000000..bc5eff9bada7
--- /dev/null
+++ b/src/Xanthous/Data/Levels.hs
@@ -0,0 +1,170 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+--------------------------------------------------------------------------------
+module Xanthous.Data.Levels
+  ( Levels
+  , allLevels
+  , nextLevel
+  , prevLevel
+  , mkLevels1
+  , mkLevels
+  , oneLevel
+  , current
+  , ComonadStore(..)
+  ) where
+--------------------------------------------------------------------------------
+import           Xanthous.Prelude hiding ((<.>), Empty, foldMap, levels)
+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)
+    deriving (ComonadStore Int) via (Zipper Seq)
+
+type instance Element (Levels a) = a
+instance MonoFoldable (Levels a)
+instance MonoFunctor (Levels a)
+instance MonoTraversable (Levels a)
+
+instance Traversable Levels where
+  traverse f (Levels z) = Levels <$> traverse f z
+
+instance Foldable1 Levels
+
+instance Traversable1 Levels where
+  traverse1 f (Levels z) = seek (pos z) . 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₂
+
+-- | 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
+  | pos levs + 1 < size (levelZipper levs)
+  = pure $ seeks succ levs
+  | otherwise
+  = genLevel <&> \level ->
+      seek (pos levs + 1) . partialMkLevels $ level <| allLevels levs
+
+-- | 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 :: Int -- ^ 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, length _levels - 1)
+    pure AltLevels {..}
+  shrink als = do
+    _levels <- shrink $ als ^. levels
+    _currentLevel <- filter (between 0 $ length _levels - 1)
+                    $ 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/src/Xanthous/Game/Arbitrary.hs b/src/Xanthous/Game/Arbitrary.hs
index a4e0255ca8c2..3be711099c23 100644
--- a/src/Xanthous/Game/Arbitrary.hs
+++ b/src/Xanthous/Game/Arbitrary.hs
@@ -5,15 +5,17 @@
 --------------------------------------------------------------------------------
 module Xanthous.Game.Arbitrary where
 --------------------------------------------------------------------------------
-import           Xanthous.Prelude
+import           Xanthous.Prelude hiding (levels, foldMap)
 --------------------------------------------------------------------------------
 import           Test.QuickCheck
 import           System.Random
+import           Data.Foldable (foldMap)
 --------------------------------------------------------------------------------
-import           Xanthous.Game.State
+import           Xanthous.Data.Levels
+import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Entities.Entities ()
 import           Xanthous.Entities.Character
-import qualified Xanthous.Data.EntityMap as EntityMap
+import           Xanthous.Game.State
 --------------------------------------------------------------------------------
 
 instance Arbitrary GameState where
@@ -21,9 +23,13 @@ instance Arbitrary GameState where
     chr <- arbitrary @Character
     charPos <- arbitrary
     _messageHistory <- arbitrary
-    (_characterEntityID, _entities) <- arbitrary <&>
-      EntityMap.insertAtReturningID charPos (SomeEntity chr)
-    _revealedPositions <- fmap setFromList . sublistOf $ EntityMap.positions _entities
+    levels <- arbitrary
+    let (_characterEntityID, currentLevel) =
+          EntityMap.insertAtReturningID charPos (SomeEntity chr)
+          $ extract levels
+        _levels = levels & current .~ currentLevel
+    _revealedPositions <- fmap setFromList . sublistOf
+                         $ foldMap EntityMap.positions levels
     _randomGen <- mkStdGen <$> arbitrary
     let _promptState = NoPrompt -- TODO
     _activePanel <- arbitrary
diff --git a/src/Xanthous/Game/Lenses.hs b/src/Xanthous/Game/Lenses.hs
index f7f4648dd5ed..010fcb7022b5 100644
--- a/src/Xanthous/Game/Lenses.hs
+++ b/src/Xanthous/Game/Lenses.hs
@@ -25,6 +25,7 @@ import           Control.Monad.Random (getRandom)
 --------------------------------------------------------------------------------
 import           Xanthous.Game.State
 import           Xanthous.Data
+import           Xanthous.Data.Levels
 import qualified Xanthous.Data.EntityMap as EntityMap
 import           Xanthous.Data.EntityMap.Graphics (visiblePositions)
 import           Xanthous.Entities.Character (Character, mkCharacter)
@@ -38,11 +39,12 @@ initialStateFromSeed :: Int -> GameState
 initialStateFromSeed seed =
   let _randomGen = mkStdGen seed
       chr = mkCharacter
-      (_characterEntityID, _entities)
+      (_characterEntityID, level)
         = EntityMap.insertAtReturningID
           (Position 0 0)
           (SomeEntity chr)
           mempty
+      _levels = oneLevel level
       _messageHistory = mempty
       _revealedPositions = mempty
       _promptState = NoPrompt
@@ -108,4 +110,4 @@ entitiesCollision
 entitiesCollision = join . maximumMay . fmap entityCollision
 
 collisionAt :: MonadState GameState m => Position -> m (Maybe Collision)
-collisionAt pos = uses (entities . EntityMap.atPosition pos) entitiesCollision
+collisionAt p = uses (entities . EntityMap.atPosition p) entitiesCollision
diff --git a/src/Xanthous/Game/State.hs b/src/Xanthous/Game/State.hs
index 171f381e6b74..7587618c968b 100644
--- a/src/Xanthous/Game/State.hs
+++ b/src/Xanthous/Game/State.hs
@@ -58,7 +58,7 @@ module Xanthous.Game.State
   , allRevealed
   ) where
 --------------------------------------------------------------------------------
-import           Xanthous.Prelude
+import           Xanthous.Prelude hiding (levels)
 --------------------------------------------------------------------------------
 import           Data.List.NonEmpty ( NonEmpty((:|)))
 import qualified Data.List.NonEmpty as NonEmpty
@@ -80,6 +80,7 @@ import qualified Graphics.Vty.Image as Vty
 --------------------------------------------------------------------------------
 import           Xanthous.Util (KnownBool(..))
 import           Xanthous.Data
+import           Xanthous.Data.Levels
 import           Xanthous.Data.EntityMap (EntityMap, EntityID)
 import           Xanthous.Data.EntityChar
 import           Xanthous.Data.VectorBag
@@ -359,8 +360,8 @@ instance Draw SomeEntity where
   drawPriority (SomeEntity ent) = drawPriority ent
 
 instance Brain SomeEntity where
-  step ticks (Positioned pos (SomeEntity ent)) =
-    fmap SomeEntity <$> step ticks (Positioned pos ent)
+  step ticks (Positioned p (SomeEntity ent)) =
+    fmap SomeEntity <$> step ticks (Positioned p ent)
 
 downcastEntity :: forall (a :: Type). (Typeable a) => SomeEntity -> Maybe a
 downcastEntity (SomeEntity e) = cast e
@@ -413,7 +414,7 @@ instance Arbitrary DebugState where
   arbitrary = genericArbitrary
 
 data GameState = GameState
-  { _entities          :: !(EntityMap SomeEntity)
+  { _levels            :: !(Levels (EntityMap SomeEntity))
   , _revealedPositions :: !(Set Position)
   , _characterEntityID :: !EntityID
   , _messageHistory    :: !MessageHistory
@@ -433,6 +434,9 @@ data GameState = GameState
            GameState
 makeLenses ''GameState
 
+entities :: Lens' GameState (EntityMap SomeEntity)
+entities = levels . current
+
 instance Eq GameState where
   (==) = (==) `on` \gs ->
     ( gs ^. entities
diff --git a/src/Xanthous/Util/Comonad.hs b/src/Xanthous/Util/Comonad.hs
new file mode 100644
index 000000000000..9e158cc8e2d4
--- /dev/null
+++ b/src/Xanthous/Util/Comonad.hs
@@ -0,0 +1,24 @@
+--------------------------------------------------------------------------------
+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/test/Spec.hs b/test/Spec.hs
index 8141b83e9771..ba8f868a8172 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,7 +1,10 @@
-import Test.Prelude
+--------------------------------------------------------------------------------
+import           Test.Prelude
+--------------------------------------------------------------------------------
 import qualified Xanthous.Data.EntityCharSpec
 import qualified Xanthous.Data.EntityMapSpec
 import qualified Xanthous.Data.EntityMap.GraphicsSpec
+import qualified Xanthous.Data.LevelsSpec
 import qualified Xanthous.DataSpec
 import qualified Xanthous.Entities.RawsSpec
 import qualified Xanthous.GameSpec
@@ -12,6 +15,7 @@ import qualified Xanthous.Util.GraphicsSpec
 import qualified Xanthous.Util.GraphSpec
 import qualified Xanthous.Util.InflectionSpec
 import qualified Xanthous.UtilSpec
+--------------------------------------------------------------------------------
 
 main :: IO ()
 main = defaultMain test
@@ -21,6 +25,7 @@ test = testGroup "Xanthous"
   [ Xanthous.Data.EntityCharSpec.test
   , Xanthous.Data.EntityMapSpec.test
   , Xanthous.Data.EntityMap.GraphicsSpec.test
+  , Xanthous.Data.LevelsSpec.test
   , Xanthous.Entities.RawsSpec.test
   , Xanthous.GameSpec.test
   , Xanthous.Generators.UtilSpec.test
diff --git a/test/Xanthous/Data/LevelsSpec.hs b/test/Xanthous/Data/LevelsSpec.hs
new file mode 100644
index 000000000000..eb742539032f
--- /dev/null
+++ b/test/Xanthous/Data/LevelsSpec.hs
@@ -0,0 +1,60 @@
+--------------------------------------------------------------------------------
+module Xanthous.Data.LevelsSpec (main, test) where
+--------------------------------------------------------------------------------
+import Test.Prelude hiding (levels)
+--------------------------------------------------------------------------------
+import qualified Data.Aeson as JSON
+--------------------------------------------------------------------------------
+import Xanthous.Util (between)
+import Xanthous.Data.Levels
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain test
+
+test :: TestTree
+test = testGroup "Xanthous.Data.Levels"
+  [ testGroup "current"
+    [ testProperty "view is extract" $ \(levels :: Levels Int) ->
+        levels ^. current === extract levels
+    , testProperty "set replaces current" $ \(levels :: Levels Int) new ->
+        extract (set current new levels) === new
+    , testProperty "set extract is id" $ \(levels :: Levels Int) ->
+        set current (extract levels) levels === levels
+    , testProperty "set y ∘ set x ≡ set y" $ \(levels :: Levels Int) x y ->
+        set current y (set current x levels) === set current y levels
+    ]
+  , localOption (QuickCheckTests 20)
+  $ testBatch $ semigroup @(Levels Int) (error "unused", 1 :: Int)
+  , testGroup "next/prev"
+    [ testGroup "nextLevel"
+      [ testProperty "seeks forwards" $ \(levels :: Levels Int) genned ->
+          (pos . runIdentity . nextLevel (Identity genned) $ levels)
+          === pos levels + 1
+      , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned ->
+          let levels' = runIdentity . nextLevel (Identity genned) $ levels
+          in between 0 (length levels') $ pos levels'
+      , testProperty "extract is total" $ \(levels :: Levels Int) genned ->
+          let levels' = runIdentity . nextLevel (Identity genned) $ levels
+          in total $ extract levels'
+      ]
+    , testGroup "prevLevel"
+      [ testProperty "seeks backwards" $ \(levels :: Levels Int) ->
+          case prevLevel levels of
+            Nothing -> property Discard
+            Just levels' -> pos levels' === pos levels - 1
+      , testProperty "maintains the invariant" $ \(levels :: Levels Int) ->
+          case prevLevel levels of
+            Nothing -> property Discard
+            Just levels' -> property $ between 0 (length levels') $ pos levels'
+      , testProperty "extract is total" $ \(levels :: Levels Int) ->
+          case prevLevel levels of
+            Nothing -> property Discard
+            Just levels' -> total $ extract levels'
+      ]
+    ]
+  , testGroup "JSON"
+    [ testProperty "toJSON/parseJSON round-trip" $ \(levels :: Levels Int) ->
+        JSON.decode (JSON.encode levels) === Just levels
+    ]
+  ]
diff --git a/xanthous.cabal b/xanthous.cabal
index 090739c2894b..702496b2906d 100644
--- a/xanthous.cabal
+++ b/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 36af39a9e3b4e97923c1b363d7d84e2c99f126efd908778d0d048d0c472f2723
+-- hash: eb0a7cd56cc2ea885be582c8ea7113a5f50f96a8d1b12ed27ca1a0271a45ad03
 
 name:           xanthous
 version:        0.1.0.0
@@ -37,6 +37,7 @@ library
       Xanthous.Data.EntityChar
       Xanthous.Data.EntityMap
       Xanthous.Data.EntityMap.Graphics
+      Xanthous.Data.Levels
       Xanthous.Data.VectorBag
       Xanthous.Entities.Character
       Xanthous.Entities.Creature
@@ -65,6 +66,7 @@ library
       Xanthous.Random
       Xanthous.Resource
       Xanthous.Util
+      Xanthous.Util.Comonad
       Xanthous.Util.Graph
       Xanthous.Util.Graphics
       Xanthous.Util.Inflection
@@ -89,6 +91,7 @@ library
     , checkers
     , classy-prelude
     , comonad
+    , comonad-extras
     , constraints
     , containers
     , data-default
@@ -109,6 +112,7 @@ library
     , megaparsec
     , mtl
     , optparse-applicative
+    , pointed
     , quickcheck-instances
     , quickcheck-text
     , random
@@ -120,6 +124,7 @@ library
     , semigroupoids
     , stache
     , streams
+    , text
     , text-zipper
     , tomland
     , vector
@@ -139,6 +144,7 @@ executable xanthous
       Xanthous.Data.EntityChar
       Xanthous.Data.EntityMap
       Xanthous.Data.EntityMap.Graphics
+      Xanthous.Data.Levels
       Xanthous.Data.VectorBag
       Xanthous.Entities.Character
       Xanthous.Entities.Creature
@@ -167,6 +173,7 @@ executable xanthous
       Xanthous.Random
       Xanthous.Resource
       Xanthous.Util
+      Xanthous.Util.Comonad
       Xanthous.Util.Graph
       Xanthous.Util.Graphics
       Xanthous.Util.Inflection
@@ -190,6 +197,7 @@ executable xanthous
     , checkers
     , classy-prelude
     , comonad
+    , comonad-extras
     , constraints
     , containers
     , data-default
@@ -210,6 +218,7 @@ executable xanthous
     , megaparsec
     , mtl
     , optparse-applicative
+    , pointed
     , quickcheck-instances
     , quickcheck-text
     , random
@@ -221,6 +230,7 @@ executable xanthous
     , semigroupoids
     , stache
     , streams
+    , text
     , text-zipper
     , tomland
     , vector
@@ -238,6 +248,7 @@ test-suite test
       Xanthous.Data.EntityCharSpec
       Xanthous.Data.EntityMap.GraphicsSpec
       Xanthous.Data.EntityMapSpec
+      Xanthous.Data.LevelsSpec
       Xanthous.DataSpec
       Xanthous.Entities.RawsSpec
       Xanthous.GameSpec
@@ -265,6 +276,7 @@ test-suite test
     , checkers
     , classy-prelude
     , comonad
+    , comonad-extras
     , constraints
     , containers
     , data-default
@@ -286,6 +298,7 @@ test-suite test
     , megaparsec
     , mtl
     , optparse-applicative
+    , pointed
     , quickcheck-instances
     , quickcheck-text
     , random
@@ -300,6 +313,7 @@ test-suite test
     , tasty
     , tasty-hunit
     , tasty-quickcheck
+    , text
     , text-zipper
     , tomland
     , vector