-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Handles cache invalidation if the distance
-- limit is modified between invocations of
-- the 'Path' command.
module Swarm.Game.Step.Path.Cache.DistanceLimit (
  getDistanceLimitInvalidation,
  withinDistance,
) where

import Control.Monad (unless)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Swarm.Game.Location
import Swarm.Game.Step.Path.Type

-- |
-- A greater distance limit might yield a shorter path
-- if there was a better route that just needed to venture outside
-- of the allowed radius.
--
-- On the other hand, a smaller distance limit /will not/ invalidate
-- the cache so long as all cells on the path are within the new limit.
getDistanceLimitInvalidation ::
  -- | current robot location
  Location ->
  -- | original path
  NonEmpty Location ->
  -- | current limit
  Maybe Integer ->
  -- | previous limit
  Maybe Integer ->
  Either DistanceLimitChange ()
-- Limit unchanged:
getDistanceLimitInvalidation :: Location
-> NonEmpty Location
-> Maybe Integer
-> Maybe Integer
-> Either DistanceLimitChange ()
getDistanceLimitInvalidation Location
_ NonEmpty Location
_ Maybe Integer
Nothing Maybe Integer
Nothing = () -> Either DistanceLimitChange ()
forall a. a -> Either DistanceLimitChange a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
-- Limit was increased to infinity:
getDistanceLimitInvalidation Location
_ NonEmpty Location
_ Maybe Integer
Nothing (Just Integer
_) = DistanceLimitChange -> Either DistanceLimitChange ()
forall a b. a -> Either a b
Left DistanceLimitChange
LimitIncreased
-- Limit was decreased from infinity:
getDistanceLimitInvalidation Location
robotLoc NonEmpty Location
pathCells (Just Integer
currLimit) Maybe Integer
Nothing =
  Location
-> NonEmpty Location -> Integer -> Either DistanceLimitChange ()
handleLimitDecreased Location
robotLoc NonEmpty Location
pathCells Integer
currLimit
getDistanceLimitInvalidation Location
robotLoc NonEmpty Location
pathCells (Just Integer
currLimit) (Just Integer
prevLimit)
  | Integer
currLimit Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
prevLimit = Location
-> NonEmpty Location -> Integer -> Either DistanceLimitChange ()
handleLimitDecreased Location
robotLoc NonEmpty Location
pathCells Integer
currLimit
  | Integer
currLimit Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
prevLimit = DistanceLimitChange -> Either DistanceLimitChange ()
forall a b. a -> Either a b
Left DistanceLimitChange
LimitIncreased
  | Bool
otherwise = () -> Either DistanceLimitChange ()
forall a. a -> Either DistanceLimitChange a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Limit unchanged

handleLimitDecreased ::
  Location ->
  NonEmpty Location ->
  Integer ->
  Either DistanceLimitChange ()
handleLimitDecreased :: Location
-> NonEmpty Location -> Integer -> Either DistanceLimitChange ()
handleLimitDecreased Location
robotLoc NonEmpty Location
pathCells Integer
currLimit =
  Bool
-> Either DistanceLimitChange () -> Either DistanceLimitChange ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Location -> Bool) -> [Location] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Integer -> Location -> Location -> Bool
withinDistance Integer
currLimit Location
robotLoc) ([Location] -> Bool) -> [Location] -> Bool
forall a b. (a -> b) -> a -> b
$ NonEmpty Location -> [Location]
forall a. NonEmpty a -> [a]
NE.tail NonEmpty Location
pathCells) (Either DistanceLimitChange () -> Either DistanceLimitChange ())
-> Either DistanceLimitChange () -> Either DistanceLimitChange ()
forall a b. (a -> b) -> a -> b
$
    DistanceLimitChange -> Either DistanceLimitChange ()
forall a b. a -> Either a b
Left DistanceLimitChange
PathExceededLimit

-- * Utility functions

-- | This function is shared between path computation logic
-- and patch cache invalidation logic to ensure that
-- the choice of inequality operator is consistent (e.g. @<@ vs. @<=@).
withinDistance ::
  -- | distance limit
  Integer ->
  -- | current robot location
  Location ->
  -- | target location
  Location ->
  Bool
withinDistance :: Integer -> Location -> Location -> Bool
withinDistance Integer
distLimit Location
robotLoc = (Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
distLimit) (Integer -> Bool) -> (Location -> Integer) -> Location -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Integer) -> (Location -> Int32) -> Location -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> Location -> Int32
manhattan Location
robotLoc