disambiguate 'maybe blindness' for distances

src/Swarm/Game/Log.hs

@@ -20,6 +20,7 @@ module Swarm.Game.Log (
 
   -- * Robot log entries
   LogEntry (..),
+  LogLocation (..),
   leText,
   leSource,
   leRobotName,
@@ -51,6 +52,9 @@ data LogSource
     ErrorTrace ErrorLevel
   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
 
+data LogLocation a = Omnipresent | Located a
+  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)
+
 -- | An entry in a robot's log.
 data LogEntry = LogEntry
   { _leTime :: TickNumber
@@ -62,7 +66,7 @@ data LogEntry = LogEntry
   -- ^ The name of the robot that generated the entry.
   , _leRobotID :: Int
   -- ^ The ID of the robot that generated the entry.
-  , _leLocation :: Maybe (Cosmo Location)
+  , _leLocation :: LogLocation (Cosmo Location)
   -- ^ Location of the robot at log entry creation.
   -- "Nothing" represents omnipresence for the purpose of proximity.
   -- TODO: Define a type isomorphic to Maybe that makes this explict.

src/Swarm/Game/State.hs

@@ -693,11 +693,16 @@ messageNotifications = to getNotif
 messageIsRecent :: GameState -> LogEntry -> Bool
 messageIsRecent gs e = addTicks 1 (e ^. leTime) >= gs ^. ticks
 
--- | If the log location is 'Nothing', consider it omnipresent.
+-- | Reconciles the possibilities of log messages being
+-- omnipresent and robots being in different worlds
 messageIsFromNearby :: Cosmo Location -> LogEntry -> Bool
-messageIsFromNearby l e = maybe True f (e ^. leLocation)
+messageIsFromNearby l e = case e ^. leLocation of
+  Omnipresent -> True
+  Located x -> f x
  where
-  f logLoc = maybe False (<= hearingDistance) $ cosmoMeasure manhattan l logLoc
+  f logLoc = case cosmoMeasure manhattan l logLoc of
+    InfinitelyFar -> False
+    Measurable x -> x <= hearingDistance
 
 -- | Given a current mapping from robot names to robots, apply a
 --   'ViewCenterRule' to derive the location it refers to.  The result
@@ -787,18 +792,22 @@ data RobotRange
 --     both radii.
 --   * If the base has an @antenna@ installed, it also doubles both radii.
 focusedRange :: GameState -> Maybe RobotRange
-focusedRange g = computedRange <$ focusedRobot g
+focusedRange g = checkRange <$ focusedRobot g
  where
-  computedRange
-    | g ^. creativeMode || g ^. worldScrollable || r <= minRadius = Close
-    | r > maxRadius = Far
-    | otherwise = MidRange $ (r - minRadius) / (maxRadius - minRadius)
+  checkRange = case r of
+    InfinitelyFar -> Far
+    Measurable r' -> computedRange r'
+
+  computedRange r'
+    | g ^. creativeMode || g ^. worldScrollable || r' <= minRadius = Close
+    | r' > maxRadius = Far
+    | otherwise = MidRange $ (r' - minRadius) / (maxRadius - minRadius)
 
   -- Euclidean distance from the base to the view center.
-  r = fromMaybe 1000000000 $ do
+  r = case g ^. robotMap . at 0 of
     -- if the base doesn't exist, we have bigger problems
-    br <- g ^. robotMap . at 0
-    cosmoMeasure euclidean (g ^. viewCenter) (br ^. robotLocation)
+    Nothing -> InfinitelyFar
+    Just br -> cosmoMeasure euclidean (g ^. viewCenter) (br ^. robotLocation)
 
   -- See whether the base or focused robot have antennas installed.
   baseInv, focInv :: Maybe Inventory
@@ -1102,8 +1111,8 @@ scenarioToGameState scenario (LaunchParams (Identity userSeed) (Identity toRun))
       & knownEntities .~ scenario ^. scenarioKnown
       & worldNavigation .~ scenario ^. scenarioNavigation
       & multiWorld .~ allSubworldsMap theSeed
-      -- TODO: Should we allow subworlds to have their own scrollability?
-      -- Leaning toward yes, but for now just adopt the root world scrollability
+      -- TODO (#1370): Should we allow subworlds to have their own scrollability?
+      -- Leaning toward no , but for now just adopt the root world scrollability
       -- as being universal.
       & worldScrollable .~ NE.head (scenario ^. scenarioWorlds) ^. to scrollable
       & viewCenterRule .~ VCRobot baseID

src/Swarm/Game/Step.hs

@@ -519,7 +519,7 @@ createLogEntry source msg = do
   rn <- use robotName
   time <- use ticks
   loc <- use robotLocation
-  pure $ LogEntry time source rn rid (Just loc) msg
+  pure $ LogEntry time source rn rid (Located loc) msg
 
 -- | Print some text via the robot's log.
 traceLog :: (Has (State GameState) sig m, Has (State Robot) sig m) => LogSource -> Text -> m LogEntry
@@ -1617,25 +1617,17 @@ execConst c vs s k = do
         loc <- use robotLocation
         m <- traceLog Said msg -- current robot will inserted to robot set, so it needs the log
         emitMessage m
-        let manhattanToLog :: Cosmo Location -> Maybe (Cosmo Location) -> Maybe Int32
-            -- Measures the Manhattan distance between a robot and a (Maybe) log location.
-            -- If log location is Nothing, it is \"omnipresent\" and therefore distance is zero.
-            manhattanToLog robLoc maybeLogLoc = case maybeLogLoc of
-              Just logLoc -> cosmoMeasure manhattan robLoc logLoc
-              Nothing -> Just 0
+        let measureToLog robLoc rawLogLoc = case rawLogLoc of
+              Located logLoc -> cosmoMeasure manhattan robLoc logLoc
+              Omnipresent -> Measurable 0
+            isEarlierThan = (<) `on` (^. leTime)
+            isFartherThan = (>) `on` (measureToLog rl . view leLocation)
             addLatestClosest rl = \case
               Seq.Empty -> Seq.singleton m
               es Seq.:|> e
-                | e ^. leTime < m ^. leTime -> es |> e |> m
-                | (cmpManhattan `on` (manhattanToLog rl . view leLocation)) e m -> es |> m
+                | e `isEarlierThan` m -> es |> e |> m
+                | e `isFartherThan` m -> es |> m
                 | otherwise -> es |> e
-             where
-              -- Returns True if M1 is not smaller than M2. 'Nothing' is treated as infinite.
-              -- TODO: Should probably define a new, parameterized datatype isomorphic to
-              -- Maybe that makes this convention explicit.
-              cmpManhattan maybeM1 maybeM2 = case maybeM1 of
-                Nothing -> True
-                Just m1 -> maybe False (m1 >) maybeM2
         let addToRobotLog :: Has (State GameState) sgn m => Robot -> m ()
             addToRobotLog r = do
               r' <- execState r $ do
@@ -2658,7 +2650,9 @@ isPrivilegedBot = (||) <$> use systemRobot <*> use creativeMode
 -- Requirement is waived if the bot is privileged.
 isNearbyOrExempt :: Bool -> Cosmo Location -> Cosmo Location -> Bool
 isNearbyOrExempt privileged myLoc otherLoc =
-  privileged || maybe False (<= 1) (cosmoMeasure manhattan myLoc otherLoc)
+  privileged || case cosmoMeasure manhattan myLoc otherLoc of
+    InfinitelyFar -> False
+    Measurable x -> x <= 1
 
 grantAchievement ::
   (Has (State GameState) sig m, Has (Lift IO) sig m) =>

src/Swarm/Game/Universe.hs

@@ -6,7 +6,6 @@
 module Swarm.Game.Universe where
 
 import Control.Lens (makeLenses, view)
-import Control.Monad (guard)
 import Data.Function (on)
 import Data.Int (Int32)
 import Data.Text (Text)
@@ -58,12 +57,14 @@ instance (FromJSON a) => FromJSON (Cosmo a) where
 defaultCosmoLocation :: Cosmo Location
 defaultCosmoLocation = Cosmo defaultRootSubworldName origin
 
--- | Returns 'Nothing' if not within the same subworld.
--- TODO: Define a new datatype isomorphic to Maybe for this.
-cosmoMeasure :: (a -> a -> b) -> Cosmo a -> Cosmo a -> Maybe b
-cosmoMeasure f a b = do
-  guard $ ((==) `on` view subworld) a b
-  pure $ (f `on` view planar) a b
+data DistanceMeasure b = Measurable b | InfinitelyFar
+  deriving (Eq, Ord)
+
+-- | Returns 'InfinitelyFar' if not within the same subworld.
+cosmoMeasure :: (a -> a -> b) -> Cosmo a -> Cosmo a -> DistanceMeasure b
+cosmoMeasure f a b
+  | ((/=) `on` view subworld) a b = InfinitelyFar
+  | otherwise = Measurable $ (f `on` view planar) a b
 
 offsetBy :: Cosmo Location -> V2 Int32 -> Cosmo Location
 offsetBy loc v = fmap (.+^ v) loc

src/Swarm/TUI/Model.hs

@@ -272,7 +272,7 @@ logEvent src (who, rid) msg el =
     & notificationsCount %~ succ
     & notificationsContent %~ (l :)
  where
-  l = LogEntry (TickNumber 0) src who rid Nothing msg
+  l = LogEntry (TickNumber 0) src who rid Omnipresent msg
 
 -- | Create a 'GameStateConfig' record from the 'RuntimeState'.
 mkGameStateConfig :: RuntimeState -> GameStateConfig