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

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>

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

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)

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)

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

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