wip

src/Swarm/Game/Scenario/Topography/Navigation/Portal.hs

@@ -27,7 +27,7 @@ import Linear (V2, negated)
 import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Navigation.Waypoint
 import Swarm.Game.Universe
-import Swarm.Util (allEqual, binTuples, both, failT, quote, sequenceTuple)
+import Swarm.Util (allEqual, binTuples, both, failT, quote)
 
 type WaypointMap = M.Map WaypointName (NonEmpty Location)
 
@@ -249,10 +249,30 @@ ensureSpatialConsistency xs =
 
   groupedBySubworldPair ::
     Map (SubworldName, SubworldName) (NonEmpty (Signed (Location, Location)))
-  groupedBySubworldPair = binTuples $ map (sequenceTuple . fmap tuplify) normalizedOrdering
+  groupedBySubworldPair = binTuples $ map (sequenceSigned . fmap tuplify) normalizedOrdering
 
   vectorized :: Map (SubworldName, SubworldName) (NonEmpty (V2 Int32))
   vectorized = M.map (NE.map (getSigned . fmap (uncurry (.-.)))) groupedBySubworldPair
 
   nonUniform :: Map (SubworldName, SubworldName) (NonEmpty (V2 Int32))
   nonUniform = M.filter ((not . allEqual) . NE.toList) vectorized
+
+-- | This signature looks a lot like the Traversable instance:
+-- @
+-- instance Traversable Signed where
+--   traverse f (Positive x) = Positive <$> f x
+--   traverse f (Negative x) = Negative <$> f x
+-- @
+--
+-- if we were to substitute "id" for f:
+-- @
+--   traverse id (Positive x) = Positive <$> id x
+--   traverse id (Negative x) = Negative <$> id x
+-- @
+sequenceSigned ::
+  Functor f =>
+  Signed (f a) ->
+  f (Signed a)
+sequenceSigned = \case
+  Positive x -> Positive <$> x
+  Negative x -> Negative <$> x

src/Swarm/Util.hs

@@ -22,8 +22,7 @@ module Swarm.Util (
   findDup,
   both,
   allEqual,
-  sequenceTuple,
-
+
   -- * Directory utilities
   readFileMay,
   readFileMayT,
@@ -195,22 +194,6 @@ allEqual :: (Ord a) => [a] -> Bool
 allEqual [] = True
 allEqual (x : xs) = all (== x) xs
 
--- | This function has a lamentable basis.
--- The 'sequenceA' function requires an 'Applicative' instance
--- for the inner 'Functor'. However, the 'Applicative' instance
--- of @(,)@ (the two-element tuple) requires a 'Monoid' instance
--- for the first element!
--- See: https://hackage.haskell.org/package/base-4.18.0.0/docs/src/GHC.Base.html#line-523
---
--- The 'sequenceA' operation does not affect the first element
--- of the tuple, so it shouldn't matter whether it has a 'Monoid' instance!
--- To satisfy the compiler, we abuse a list to first wrap and then unwrap after a traversal.
-sequenceTuple ::
-  Traversable f =>
-  f (a, b) ->
-  (a, f b)
-sequenceTuple = first head . traverse (first pure)
-
 ------------------------------------------------------------
 -- Directory stuff