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>

1 files changed, 49 insertions, 47 deletions

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