refactor(xan): Switch to V2 over tuples most places r/1207

These are generally rather nicer to work due to some typeclass instances,
and integrate better with other ecosystems for things like linear
algebra etc.

Change-Id: I546c8da7b17234648f3d612b28741c1fded25447
Reviewed-on: https://cl.tvl.fyi/c/depot/+/910
Tested-by: BuildkiteCI
Reviewed-by: glittershark <grfn@gws.fyi>

5 files changed, 69 insertions, 64 deletions

diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
index ada201ef3d6c..be904662f3f7 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/CaveAutomata.hs
@@ -19,6 +19,7 @@ import           Xanthous.Util (between)
 import           Xanthous.Util.Optparse
 import           Xanthous.Data (Dimensions, width, height)
 import           Xanthous.Generators.Util
+import           Linear.V2
 --------------------------------------------------------------------------------
 
 data Params = Params
@@ -102,7 +103,7 @@ generate' params dims = do
 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, 0), (dims ^. width, dims ^. height))) $ \pos -> do
+  for_ (range (0, V2 (dims ^. width) (dims ^. height))) $ \pos -> do
     neighs <- lift $ numAliveNeighborsM origCells pos
     origValue <- lift $ readArray origCells pos
     lift . writeArray cells pos
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
index 7fde0075e64f..f30713ce1182 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Dungeon.hs
@@ -159,14 +159,14 @@ fillRoom cells room =
       V2 dimx dimy = room ^. dimensions
   in for_ [posx .. posx + dimx] $ \x ->
        for_ [posy .. posy + dimy] $ \y ->
-         lift $ writeArray cells (x, y) True
+         lift $ writeArray cells (V2 x y) True
 
-corridorBetween :: MonadRandom m => Room -> Room -> m [(Word, Word)]
+corridorBetween :: MonadRandom m => Room -> Room -> m [V2 Word]
 corridorBetween originRoom destinationRoom
   = straightLine <$> origin <*> destination
   where
-    origin = choose . NE.fromList . map toTuple =<< originEdge
-    destination = choose . NE.fromList . map toTuple =<< destinationEdge
+    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
@@ -188,4 +188,3 @@ corridorBetween originRoom destinationRoom
         (EQ, EQ) -> TopLeft -- should never happen
 
     destinationCorner = opposite originCorner
-    toTuple (V2 x y) = (x, y)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs b/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
index ed4cc87e79d7..8ebcc7f4da83 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/LevelContents.hs
@@ -14,13 +14,15 @@ 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.Util
 import           Xanthous.Random
-import           Xanthous.Data ( Position, _Position, positionFromPair
-                               , rotations, arrayNeighbors, Neighbors(..)
-                               , neighborPositions
-                               )
+import           Xanthous.Data
+                 ( positionFromV2,  Position, _Position
+                 , rotations, arrayNeighbors, Neighbors(..)
+                 , neighborPositions
+                 )
 import           Xanthous.Data.EntityMap (EntityMap, _EntityMap)
 import           Xanthous.Entities.Raws (rawsWithType, RawType)
 import qualified Xanthous.Entities.Item as Item
@@ -49,7 +51,7 @@ randomDoors cells = do
   doorRatio <- getRandomR subsetRange
   let numDoors = floor $ doorRatio * fromIntegral (length candidateCells)
       doorPositions =
-        removeAdjacent . fmap positionFromPair . take numDoors $ candidateCells
+        removeAdjacent . fmap positionFromV2 . take numDoors $ candidateCells
       doors = zip doorPositions $ repeat unlockedDoor
   pure $ _EntityMap # doors
   where
@@ -92,8 +94,9 @@ tutorialMessage cells characterPosition = do
     accessiblePositionsWithin :: Int -> Cells -> Position -> [Position]
     accessiblePositionsWithin dist valid pos =
       review _Position
-      <$> filter (\(px, py) -> not $ valid ! (fromIntegral px, fromIntegral py))
-          (circle (pos ^. _Position) dist)
+      <$> filter
+            (\pt -> not $ valid ! (fromIntegral <$> pt))
+            (circle (pos ^. _Position) dist)
 
 randomEntities
   :: forall entity raw m. (MonadRandom m, RawType raw)
@@ -116,10 +119,10 @@ randomEntities newWithType sizeRange cells =
       pure $ _EntityMap # entities
 
 randomPosition :: MonadRandom m => Cells -> m Position
-randomPosition = fmap positionFromPair . choose . impureNonNull . cellCandidates
+randomPosition = fmap positionFromV2 . choose . impureNonNull . cellCandidates
 
 -- cellCandidates :: Cells -> Cells
-cellCandidates :: Cells -> Set (Word, Word)
+cellCandidates :: Cells -> Set (V2 Word)
 cellCandidates
   -- find the largest contiguous region of cells in the cave.
   = maximumBy (compare `on` length)
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
index e1e367007e65..88aadd5aadd9 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Util.hs
@@ -20,6 +20,7 @@ module Xanthous.Generators.Util
   ) where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding (Foldable, toList, for_)
+--------------------------------------------------------------------------------
 import           Data.Array.ST
 import           Data.Array.Unboxed
 import           Control.Monad.ST
@@ -28,13 +29,14 @@ 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 (Word, Word) Bool
-type Cells = UArray (Word, Word) Bool
+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)
@@ -43,28 +45,28 @@ randInitialize dims aliveChance = do
   for_ [0..dims ^. width] $ \i ->
     for_ [0..dims ^. height] $ \j -> do
       val <- (>= aliveChance) <$> getRandomR (0, 1)
-      lift $ writeArray res (i, j) val
+      lift $ writeArray res (V2 i j) val
   pure res
 
 initializeEmpty :: RandomGen g => Dimensions -> CellM g s (MCells s)
 initializeEmpty dims =
-  lift $ newArray ((0, 0), (dims ^. width, dims ^. height)) False
+  lift $ newArray (0, V2 (dims ^. width) (dims ^. height)) False
 
 numAliveNeighborsM
-  :: forall a i j m
-  . (MArray a Bool m, Ix (i, j), Integral i, Integral j)
-  => a (i, j) Bool
-  -> (i, j)
+  :: forall a i m
+  . (MArray a Bool m, Ix i, Integral i)
+  => a (V2 i) Bool
+  -> V2 i
   -> m Word
-numAliveNeighborsM cells (x, y) = do
+numAliveNeighborsM cells (V2 x y) = do
   cellBounds <- getBounds cells
   getSum <$> foldlMapM'
     (fmap (Sum . fromIntegral . fromEnum) . boundedGet cellBounds)
     neighborPositions
 
   where
-    boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> m Bool
-    boundedGet ((minX, minY), (maxX, maxY)) (i, j)
+    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> m Bool
+    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
       | x <= minX
         || y <= minY
         || x >= maxX
@@ -73,23 +75,23 @@ numAliveNeighborsM cells (x, y) = do
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
             ny = fromIntegral $ fromIntegral y + j
-        in readArray cells (nx, ny)
+        in readArray cells $ V2 nx ny
 
 numAliveNeighbors
-  :: forall a i j
-  . (IArray a Bool, Ix (i, j), Integral i, Integral j)
-  => a (i, j) Bool
-  -> (i, j)
+  :: forall a i
+  . (IArray a Bool, Ix i, Integral i)
+  => a (V2 i) Bool
+  -> V2 i
   -> Word
-numAliveNeighbors cells (x, y) =
+numAliveNeighbors cells (V2 x y) =
   let cellBounds = bounds cells
   in getSum $ foldMap
       (Sum . fromIntegral . fromEnum . boundedGet cellBounds)
       neighborPositions
 
   where
-    boundedGet :: ((i, j), (i, j)) -> (Int, Int) -> Bool
-    boundedGet ((minX, minY), (maxX, maxY)) (i, j)
+    boundedGet :: (V2 i, V2 i) -> (Int, Int) -> Bool
+    boundedGet (V2 minX minY, V2 maxX maxY) (i, j)
       | x <= minX
         || y <= minY
         || x >= maxX
@@ -98,20 +100,20 @@ numAliveNeighbors cells (x, y) =
       | otherwise =
         let nx = fromIntegral $ fromIntegral x + i
             ny = fromIntegral $ fromIntegral y + j
-        in cells ! (nx, ny)
+        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, Ix j) => a (i, j) Bool -> m ()
+fillOuterEdgesM :: (MArray a Bool m, Ix i) => a (V2 i) Bool -> m ()
 fillOuterEdgesM arr = do
-  ((minX, minY), (maxX, maxY)) <- getBounds arr
+  (V2 minX minY, V2 maxX maxY) <- getBounds arr
   for_ (range (minX, maxX)) $ \x -> do
-    writeArray arr (x, minY) True
-    writeArray arr (x, maxY) True
+    writeArray arr (V2 x minY) True
+    writeArray arr (V2 x maxY) True
   for_ (range (minY, maxY)) $ \y -> do
-    writeArray arr (minX, y) True
-    writeArray arr (maxX, y) True
+    writeArray arr (V2 minX y) True
+    writeArray arr (V2 maxX y) True
 
 cloneMArray
   :: forall a a' i e m.
@@ -128,20 +130,20 @@ 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 j.
+floodFill :: forall a i.
             ( IArray a Bool
-            , Ix (i, j)
-            , Enum i , Enum j
-            , Bounded i , Bounded j
-            , Eq i , Eq j
+            , Ix i
+            , Enum i
+            , Bounded i
+            , Eq i
             )
-          => a (i, j) Bool -- ^ array
-          -> (i, j)        -- ^ position
-          -> Set (i, j)
+          => a (V2 i) Bool -- ^ array
+          -> (V2 i)        -- ^ position
+          -> Set (V2 i)
 floodFill = go mempty
   where
-    go :: Set (i, j) -> a (i, j) Bool -> (i, j) -> Set (i, j)
-    go res arr@(bounds -> arrBounds) idx@(x, y)
+    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 =
@@ -149,7 +151,7 @@ floodFill = go mempty
               = 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)]
@@ -162,19 +164,19 @@ floodFill = go mempty
                                in r' `seq` go r' arr idx')
                      else r)
            (res & contains idx .~ True) neighbors
-{-# SPECIALIZE floodFill :: UArray (Word, Word) Bool -> (Word, Word) -> Set (Word, Word) #-}
+{-# 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 j.
+regions :: forall a i.
           ( IArray a Bool
-          , Ix (i, j)
-          , Enum i , Enum j
-          , Bounded i , Bounded j
-          , Eq i , Eq j
+          , Ix i
+          , Enum i
+          , Bounded i
+          , Eq i
           )
-        => a (i, j) Bool
-        -> [Set (i, j)]
+        => a (V2 i) Bool
+        -> [Set (V2 i)]
 regions arr
   | Just firstPoint <- findFirstPoint arr =
       let region = floodFill arr firstPoint
@@ -182,9 +184,9 @@ regions arr
       in region : regions arr'
   | otherwise = []
   where
-    findFirstPoint :: a (i, j) Bool -> Maybe (i, j)
+    findFirstPoint :: a (V2 i) Bool -> Maybe (V2 i)
     findFirstPoint = fmap fst . headMay . filter snd . assocs
-{-# SPECIALIZE regions :: UArray (Word, Word) Bool -> [Set (Word, Word)] #-}
+{-# 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
diff --git a/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
index 614170d0c4f1..cc9c9d963f5c 100644
--- a/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Generators/Village.hs
@@ -73,9 +73,9 @@ fromCave' wallPositions = failing (pure ()) $ do
 
   where
     insertEntity e pt = modify $ EntityMap.insertAt (ptToPos pt) $ SomeEntity e
-    ptToPos pt = _Position # (pt & both %~ fromIntegral)
+    ptToPos pt = _Position # (fromIntegral <$> pt)
 
-    stepOut :: Set (Word, Word) -> [[(Word, Word)]] -> MaybeT m [[(Word, Word)]]
+    stepOut :: Set (V2 Word) -> [[V2 Word]] -> MaybeT m [[V2 Word]]
     stepOut circ rooms = for rooms $ \room ->
       let nextLevels = hashNub $ toList . neighborCells =<< room
       in pure