breaks.diff

diff --git a/PLAN.org b/PLAN.org
index a79dafc..df34532 100644
--- a/PLAN.org
+++ b/PLAN.org
@@ -30,5 +30,6 @@ So how are we gonna do messages, too? Presumably there should be a status bar on
 sidebar, +status bar, and body+
 
 generalize the (Reader (BChan x)) and (Reader (MVar x)) and whatever with some unified Pipe interface
+prevent crashes by implementing valid, occupied :: Position -> Canvas -> Bool
 slurp in some enemies
 multi-square things? z-levels in the canvas? gonna need them
diff --git a/cabal.project b/cabal.project
deleted file mode 100644
index e6fdbad..0000000
--- a/cabal.project
+++ /dev/null
@@ -1 +0,0 @@
-packages: .
diff --git a/possession.cabal b/possession.cabal
index fe6cc98..36248a3 100644
--- a/possession.cabal
+++ b/possession.cabal
@@ -37,7 +37,6 @@ library
         base ^>=4.14.1.0
     exposed-modules:
       Possession
-      Data.Position
       Game.Action
       Game.Canvas
       Game.Command
diff --git a/src/Data/Position.hs b/src/Data/Position.hs
deleted file mode 100644
index aaf3747..0000000
--- a/src/Data/Position.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-module Data.Position
-  ( Position (..)
-  , V2 (..)
-  , make
-  , offset
-  ) where
-
-import Data.Ix
-import Linear.V2
-
-newtype Position = Position (V2 Int)
-  deriving stock (Eq, Ord, Show)
-  deriving newtype (Ix, Num)
-
-make :: Int -> Int -> Position
-make x y = Position (V2 x y)
-
-offset :: V2 Int -> Position -> Position
-offset v (Position p) = Position (v + p)
diff --git a/src/Game/Canvas.hs b/src/Game/Canvas.hs
index d441630..983f910 100644
--- a/src/Game/Canvas.hs
+++ b/src/Game/Canvas.hs
@@ -6,9 +6,9 @@
 module Game.Canvas where
 
 import Data.Array (Array, array, (!), (//))
-import Data.Position (Position)
-import Data.Position qualified as Position
-import Game.World (Color (..), Glyph (..))
+import Game.World (Color (..), Glyph (..), Position (..))
+import Game.World qualified as Position
+import Linear
 
 data Sprite = Sprite
   { glyph :: !Glyph,
@@ -23,17 +23,15 @@ size :: Int
 size = 16
 
 bounds :: (Position, Position)
-bounds = (0 :: Position, Position.make size size)
+bounds = (0 :: Position, Position (V2 size size))
 
 borders :: [Position]
 borders = up <> down <> left <> right
   where
-    up = Position.make <$> horizontal <*> pure 0
-    down = Position.make <$> horizontal <*> pure size
-    left = Position.make 0 <$> vertical
-    right = Position.make size <$> vertical
-    horizontal = [0..size]
-    vertical = [1..size-1]
+    up = Position.make <$> [0..size] <*> pure 0
+    down = Position.make <$> [0..size] <*> pure (size)
+    left = Position.make 0 <$> [1..(size-1)]
+    right = Position.make (size-1) <$> [1..(size-1)]
 
 newtype Canvas = Canvas {unCanvas :: Array Position Sprite}
   deriving newtype (Show)
@@ -42,7 +40,7 @@ empty :: Canvas
 empty = Canvas $ array bounds do
   x <- [0 .. size]
   y <- [0 .. size]
-  pure (Position.make x y, blankSprite)
+  pure (Position (V2 x y), blankSprite)
 
 update :: Canvas -> [(Position, Sprite)] -> Canvas
 update (Canvas arr) assocs = Canvas (arr // assocs)
diff --git a/src/Game/Ecs.hs b/src/Game/Ecs.hs
index ba3ae7c..694c3f4 100644
--- a/src/Game/Ecs.hs
+++ b/src/Game/Ecs.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -19,11 +18,10 @@ import Control.Concurrent
 import Control.Effect.Optics
 import Control.Monad
 import Control.Monad.IO.Class
+import Data.Generics.Product
 import Data.Foldable (for_)
 import Data.Maybe (isJust)
 import Data.Monoid
-import Data.Position (Position (..))
-import Data.Position qualified as Position
 import Game.Action
 import Game.Canvas qualified as Canvas
 import Game.Canvas qualified as Game (Canvas)
@@ -33,8 +31,6 @@ import Game.World qualified as World
 import Linear (V2 (..))
 import Relude.Bool.Guard
 
-type GameState = Game.State.State
-
 draw :: (Eff.Has Trace sig m, MonadIO m) => Apecs.SystemT Game.World m Game.Canvas
 draw = do
   trace "Run::draw"
@@ -42,7 +38,7 @@ draw = do
   trace (show new)
   pure (Canvas.empty `Canvas.update` new)
   where
-    go :: [(Position, Canvas.Sprite)] -> (Position, World.Glyph, World.Color) -> [(Position, Canvas.Sprite)]
+    go :: [(World.Position, Canvas.Sprite)] -> (World.Position, World.Glyph, World.Color) -> [(World.Position, Canvas.Sprite)]
     go acc (pos, chr, color) = (pos, Canvas.Sprite chr color) : acc
 
 loop ::
@@ -59,7 +55,7 @@ loop = do
 
   case next of
     Move dir -> do
-      prospective <- Position.offset dir <$> playerPosition
+      prospective <- (World.Position dir +) <$> playerPosition
       unlessM (occupied prospective) $
         movePlayer dir
     NoOp -> pure ()
@@ -72,38 +68,38 @@ loop = do
   pure ()
 
 movePlayer :: MonadIO m => V2 Int -> Apecs.SystemT Game.World m ()
-movePlayer dx = Apecs.cmap \(Position p, World.Player) -> Position (dx + p)
+movePlayer dx = Apecs.cmap \(World.Position p, World.Player) -> World.Position (dx + p)
 
-playerPosition :: (Eff.Has (State GameState) sig m, MonadIO m) => Apecs.SystemT Game.World m Position
+playerPosition :: (Eff.Has (State Game.State.State) sig m, MonadIO m) => Apecs.SystemT Game.World m World.Position
 playerPosition = do
-  (World.Player, loc) <- Apecs.get =<< use @GameState#player
+  p <- use (field @"player" @Game.State.State)
+  (World.Player, loc) <- Apecs.get p
   pure loc
 
-occupied :: MonadIO m => Position -> Apecs.SystemT Game.World m Bool
+occupied :: MonadIO m => World.Position -> Apecs.SystemT Game.World m Bool
 occupied p = isJust . getAlt <$> cfoldMap go
   where
-    go :: Position -> Alt Maybe Position
-    go x = x <$ guard (x == p)
+    go :: World.Position -> Alt Maybe World.Position
+    go x = guard (x == p) *> pure x
 
 cfoldMap :: forall w m c a. (Apecs.Members w m c, Apecs.Get w m c, Monoid a) => (c -> a) -> Apecs.SystemT w m a
-cfoldMap f = Apecs.cfold (\a b -> a <> f b) mempty
+cfoldMap f = Apecs.cfold (\a b -> a <> f b) (mempty :: a)
 
 setup :: (Eff.Has (State Game.State.State) sig m, MonadIO m) => Apecs.SystemT Game.World m ()
 setup = do
-  Apecs.newEntity (Position 3, World.Player, World.Glyph '@', World.White)
-    >>= assign @GameState #player
+  Apecs.newEntity (World.Position 3, World.Player, World.Glyph '@', World.White)
+    >>= assign (field @"player" @Game.State.State)
 
   for_ Canvas.borders \border -> do
     Apecs.newEntity (border, World.Wall, World.Glyph '#', World.White)
 
 start :: BChan Command -> MVar Action -> Game.World -> IO ()
 start cmds acts world =
-  let initialState = (Game.State.State (error "BUG: Tried to read uninitialized player"))
-   in void
-        . forkIO
-        . runTrace
-        . runReader cmds
-        . runReader acts
-        . evalState initialState
-        . Apecs.runWith world
-        $ setup *> forever loop
+  void
+    . forkIO
+    . runTrace
+    . runReader cmds
+    . runReader acts
+    . evalState (Game.State.State (error "BUG: Tried to read uninitialized player"))
+    . Apecs.runWith world
+    $ setup *> forever loop
diff --git a/src/Game/State.hs b/src/Game/State.hs
index 7d3bea5..cc60228 100644
--- a/src/Game/State.hs
+++ b/src/Game/State.hs
@@ -1,19 +1,10 @@
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-module Game.State (State (State)) where
+module Game.State where
 
 import Apecs qualified
-import Optics
 import GHC.Generics (Generic)
 
 data State = State
-  { statePlayer :: Apecs.Entity
+  { player :: Apecs.Entity
   } deriving Generic
-
-makeFieldLabels ''State
diff --git a/src/Game/World.hs b/src/Game/World.hs
index c81fe1b..a36cced 100644
--- a/src/Game/World.hs
+++ b/src/Game/World.hs
@@ -8,14 +8,21 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Game.World (module Game.World) where
 
 import Apecs
 import Control.Algebra qualified as Eff
 import Control.Carrier.Reader qualified as Eff
-import Data.Position
+import Data.Ix
+import Linear (V2 (..))
+
+newtype Position = Position (V2 Int)
+  deriving stock (Eq, Ord, Show)
+  deriving newtype (Ix, Num)
+
+make :: Int -> Int -> Position
+make x y = Position (V2 x y)
 
 newtype Glyph = Glyph Char deriving newtype (Show)
 
diff --git a/src/UI/Render.hs b/src/UI/Render.hs
index 0af44fa..0e622b3 100644
--- a/src/UI/Render.hs
+++ b/src/UI/Render.hs
@@ -4,14 +4,14 @@
 
 module UI.Render where
 
-import Brick qualified
-import Data.Position qualified as Position
 import Game.Canvas qualified as Canvas
 import Game.Canvas qualified as Game (Canvas)
 import Game.World qualified as World
 import Graphics.Vty qualified as Vty
 import Graphics.Vty.Attributes qualified as Attr
+import Linear (V2 (..))
 import UI.Resource
+import Brick qualified
 
 drawSprite :: Canvas.Sprite -> Vty.Image
 drawSprite (Canvas.Sprite (World.Glyph chr) color) = Vty.char attr chr
@@ -28,13 +28,13 @@ scanline :: Int -> Game.Canvas -> Vty.Image
 scanline idx canv = do
   let scanlines = do
         x <- [0 .. Canvas.size]
-        pure (Canvas.at canv (Position.make x idx))
+        pure (Canvas.at canv (World.Position (V2 x idx)))
   let squares = fmap drawSprite scanlines
   Vty.horizCat squares
 
 render :: Game.Canvas -> Brick.Widget Resource
 render canv =
   let allLines = [scanline x canv | x <- [0 .. Canvas.size]]
-   in Brick.viewport UI.Resource.Canvas Brick.Both
-        . Brick.raw
-        $ Vty.vertCat allLines
+  in Brick.viewport UI.Resource.Canvas Brick.Both
+     . Brick.raw
+     $ Vty.vertCat allLines