{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types for shortest-path-finding and logging
-- path-cache invalidation events.
--
-- By convention, a @[Location]@ /does not/ include the
-- starting location, whereas a @NonEmpty Location@ does.
--
-- Consequentially, an empty @[Location]@ implies that
-- the robot's current location is already at the goal location.
--
-- A gratuitous number of sum types are defined here
-- to facilitate explainability of caching behavior via logs.
module Swarm.Game.Step.Path.Type where

import Control.Lens
import Data.Aeson (ToJSON (..), genericToJSON)
import Data.IntMap.Strict (IntMap)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map qualified as M
import GHC.Generics (Generic)
import Swarm.Game.Entity
import Swarm.Game.Location
import Swarm.Game.Robot (RID)
import Swarm.Game.Robot.Walk (WalkabilityContext)
import Swarm.Game.Universe (SubworldName)
import Swarm.Util.JSON (optionsMinimize)
import Swarm.Util.Lens (makeLensesNoSigs)
import Swarm.Util.RingBuffer

maxLogEntries :: Int
maxLogEntries :: Int
maxLogEntries = Int
32

-- | This is parameterized on the starting location,
-- as we may either want to:
--
-- 1. provide the planar start location (when first /computing/ the path), or
-- 2. suppress it and only propagate the subworld name
--    (when /retrieving/ from cache), which precludes the downstream possibility
--    of accidentally mixing up the planar location of the /target/
--    with the current /robot location/.
data PathfindingParameters a = PathfindingParameters
  { forall a. PathfindingParameters a -> Maybe Integer
distanceLimit :: Maybe Integer
  -- ^ Manhattan distance limit on cells to explore
  -- (NOTE: this is not a "path length" limit)
  , forall a. PathfindingParameters a -> a
startingLoc :: a
  -- ^ Starting location
  , forall a. PathfindingParameters a -> PathfindingTarget
searchGoal :: PathfindingTarget
  -- ^ Search goal
  }
  deriving ((forall x.
 PathfindingParameters a -> Rep (PathfindingParameters a) x)
-> (forall x.
    Rep (PathfindingParameters a) x -> PathfindingParameters a)
-> Generic (PathfindingParameters a)
forall x.
Rep (PathfindingParameters a) x -> PathfindingParameters a
forall x.
PathfindingParameters a -> Rep (PathfindingParameters a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x.
Rep (PathfindingParameters a) x -> PathfindingParameters a
forall a x.
PathfindingParameters a -> Rep (PathfindingParameters a) x
$cfrom :: forall a x.
PathfindingParameters a -> Rep (PathfindingParameters a) x
from :: forall x.
PathfindingParameters a -> Rep (PathfindingParameters a) x
$cto :: forall a x.
Rep (PathfindingParameters a) x -> PathfindingParameters a
to :: forall x.
Rep (PathfindingParameters a) x -> PathfindingParameters a
Generic, PathfindingParameters a -> PathfindingParameters a -> Bool
(PathfindingParameters a -> PathfindingParameters a -> Bool)
-> (PathfindingParameters a -> PathfindingParameters a -> Bool)
-> Eq (PathfindingParameters a)
forall a.
Eq a =>
PathfindingParameters a -> PathfindingParameters a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
PathfindingParameters a -> PathfindingParameters a -> Bool
== :: PathfindingParameters a -> PathfindingParameters a -> Bool
$c/= :: forall a.
Eq a =>
PathfindingParameters a -> PathfindingParameters a -> Bool
/= :: PathfindingParameters a -> PathfindingParameters a -> Bool
Eq, Int -> PathfindingParameters a -> ShowS
[PathfindingParameters a] -> ShowS
PathfindingParameters a -> String
(Int -> PathfindingParameters a -> ShowS)
-> (PathfindingParameters a -> String)
-> ([PathfindingParameters a] -> ShowS)
-> Show (PathfindingParameters a)
forall a. Show a => Int -> PathfindingParameters a -> ShowS
forall a. Show a => [PathfindingParameters a] -> ShowS
forall a. Show a => PathfindingParameters a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PathfindingParameters a -> ShowS
showsPrec :: Int -> PathfindingParameters a -> ShowS
$cshow :: forall a. Show a => PathfindingParameters a -> String
show :: PathfindingParameters a -> String
$cshowList :: forall a. Show a => [PathfindingParameters a] -> ShowS
showList :: [PathfindingParameters a] -> ShowS
Show, [PathfindingParameters a] -> Value
[PathfindingParameters a] -> Encoding
PathfindingParameters a -> Bool
PathfindingParameters a -> Value
PathfindingParameters a -> Encoding
(PathfindingParameters a -> Value)
-> (PathfindingParameters a -> Encoding)
-> ([PathfindingParameters a] -> Value)
-> ([PathfindingParameters a] -> Encoding)
-> (PathfindingParameters a -> Bool)
-> ToJSON (PathfindingParameters a)
forall a. ToJSON a => [PathfindingParameters a] -> Value
forall a. ToJSON a => [PathfindingParameters a] -> Encoding
forall a. ToJSON a => PathfindingParameters a -> Bool
forall a. ToJSON a => PathfindingParameters a -> Value
forall a. ToJSON a => PathfindingParameters a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => PathfindingParameters a -> Value
toJSON :: PathfindingParameters a -> Value
$ctoEncoding :: forall a. ToJSON a => PathfindingParameters a -> Encoding
toEncoding :: PathfindingParameters a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [PathfindingParameters a] -> Value
toJSONList :: [PathfindingParameters a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [PathfindingParameters a] -> Encoding
toEncodingList :: [PathfindingParameters a] -> Encoding
$comitField :: forall a. ToJSON a => PathfindingParameters a -> Bool
omitField :: PathfindingParameters a -> Bool
ToJSON, (forall a b.
 (a -> b) -> PathfindingParameters a -> PathfindingParameters b)
-> (forall a b.
    a -> PathfindingParameters b -> PathfindingParameters a)
-> Functor PathfindingParameters
forall a b. a -> PathfindingParameters b -> PathfindingParameters a
forall a b.
(a -> b) -> PathfindingParameters a -> PathfindingParameters b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> PathfindingParameters a -> PathfindingParameters b
fmap :: forall a b.
(a -> b) -> PathfindingParameters a -> PathfindingParameters b
$c<$ :: forall a b. a -> PathfindingParameters b -> PathfindingParameters a
<$ :: forall a b. a -> PathfindingParameters b -> PathfindingParameters a
Functor)

-- | It is possible for the cache to be unaffected
-- by certain events, or the cache may modified without
-- fully recomputing the shortest path.
data CachePreservationMode
  = Unmodified
  | PathTruncated
  deriving (Int -> CachePreservationMode -> ShowS
[CachePreservationMode] -> ShowS
CachePreservationMode -> String
(Int -> CachePreservationMode -> ShowS)
-> (CachePreservationMode -> String)
-> ([CachePreservationMode] -> ShowS)
-> Show CachePreservationMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachePreservationMode -> ShowS
showsPrec :: Int -> CachePreservationMode -> ShowS
$cshow :: CachePreservationMode -> String
show :: CachePreservationMode -> String
$cshowList :: [CachePreservationMode] -> ShowS
showList :: [CachePreservationMode] -> ShowS
Show, CachePreservationMode -> CachePreservationMode -> Bool
(CachePreservationMode -> CachePreservationMode -> Bool)
-> (CachePreservationMode -> CachePreservationMode -> Bool)
-> Eq CachePreservationMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CachePreservationMode -> CachePreservationMode -> Bool
== :: CachePreservationMode -> CachePreservationMode -> Bool
$c/= :: CachePreservationMode -> CachePreservationMode -> Bool
/= :: CachePreservationMode -> CachePreservationMode -> Bool
Eq, (forall x. CachePreservationMode -> Rep CachePreservationMode x)
-> (forall x. Rep CachePreservationMode x -> CachePreservationMode)
-> Generic CachePreservationMode
forall x. Rep CachePreservationMode x -> CachePreservationMode
forall x. CachePreservationMode -> Rep CachePreservationMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CachePreservationMode -> Rep CachePreservationMode x
from :: forall x. CachePreservationMode -> Rep CachePreservationMode x
$cto :: forall x. Rep CachePreservationMode x -> CachePreservationMode
to :: forall x. Rep CachePreservationMode x -> CachePreservationMode
Generic, [CachePreservationMode] -> Value
[CachePreservationMode] -> Encoding
CachePreservationMode -> Bool
CachePreservationMode -> Value
CachePreservationMode -> Encoding
(CachePreservationMode -> Value)
-> (CachePreservationMode -> Encoding)
-> ([CachePreservationMode] -> Value)
-> ([CachePreservationMode] -> Encoding)
-> (CachePreservationMode -> Bool)
-> ToJSON CachePreservationMode
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CachePreservationMode -> Value
toJSON :: CachePreservationMode -> Value
$ctoEncoding :: CachePreservationMode -> Encoding
toEncoding :: CachePreservationMode -> Encoding
$ctoJSONList :: [CachePreservationMode] -> Value
toJSONList :: [CachePreservationMode] -> Value
$ctoEncodingList :: [CachePreservationMode] -> Encoding
toEncodingList :: [CachePreservationMode] -> Encoding
$comitField :: CachePreservationMode -> Bool
omitField :: CachePreservationMode -> Bool
ToJSON)

data CacheLogEntry = CacheLogEntry
  { CacheLogEntry -> Int
robot :: RID
  , CacheLogEntry -> CacheEvent
event :: CacheEvent
  }
  deriving (Int -> CacheLogEntry -> ShowS
[CacheLogEntry] -> ShowS
CacheLogEntry -> String
(Int -> CacheLogEntry -> ShowS)
-> (CacheLogEntry -> String)
-> ([CacheLogEntry] -> ShowS)
-> Show CacheLogEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheLogEntry -> ShowS
showsPrec :: Int -> CacheLogEntry -> ShowS
$cshow :: CacheLogEntry -> String
show :: CacheLogEntry -> String
$cshowList :: [CacheLogEntry] -> ShowS
showList :: [CacheLogEntry] -> ShowS
Show, CacheLogEntry -> CacheLogEntry -> Bool
(CacheLogEntry -> CacheLogEntry -> Bool)
-> (CacheLogEntry -> CacheLogEntry -> Bool) -> Eq CacheLogEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheLogEntry -> CacheLogEntry -> Bool
== :: CacheLogEntry -> CacheLogEntry -> Bool
$c/= :: CacheLogEntry -> CacheLogEntry -> Bool
/= :: CacheLogEntry -> CacheLogEntry -> Bool
Eq, (forall x. CacheLogEntry -> Rep CacheLogEntry x)
-> (forall x. Rep CacheLogEntry x -> CacheLogEntry)
-> Generic CacheLogEntry
forall x. Rep CacheLogEntry x -> CacheLogEntry
forall x. CacheLogEntry -> Rep CacheLogEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheLogEntry -> Rep CacheLogEntry x
from :: forall x. CacheLogEntry -> Rep CacheLogEntry x
$cto :: forall x. Rep CacheLogEntry x -> CacheLogEntry
to :: forall x. Rep CacheLogEntry x -> CacheLogEntry
Generic, [CacheLogEntry] -> Value
[CacheLogEntry] -> Encoding
CacheLogEntry -> Bool
CacheLogEntry -> Value
CacheLogEntry -> Encoding
(CacheLogEntry -> Value)
-> (CacheLogEntry -> Encoding)
-> ([CacheLogEntry] -> Value)
-> ([CacheLogEntry] -> Encoding)
-> (CacheLogEntry -> Bool)
-> ToJSON CacheLogEntry
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CacheLogEntry -> Value
toJSON :: CacheLogEntry -> Value
$ctoEncoding :: CacheLogEntry -> Encoding
toEncoding :: CacheLogEntry -> Encoding
$ctoJSONList :: [CacheLogEntry] -> Value
toJSONList :: [CacheLogEntry] -> Value
$ctoEncodingList :: [CacheLogEntry] -> Encoding
toEncodingList :: [CacheLogEntry] -> Encoding
$comitField :: CacheLogEntry -> Bool
omitField :: CacheLogEntry -> Bool
ToJSON)

data CacheRetrievalAttempt
  = Success
  | RecomputationRequired CacheRetreivalInapplicability
  deriving (Int -> CacheRetrievalAttempt -> ShowS
[CacheRetrievalAttempt] -> ShowS
CacheRetrievalAttempt -> String
(Int -> CacheRetrievalAttempt -> ShowS)
-> (CacheRetrievalAttempt -> String)
-> ([CacheRetrievalAttempt] -> ShowS)
-> Show CacheRetrievalAttempt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheRetrievalAttempt -> ShowS
showsPrec :: Int -> CacheRetrievalAttempt -> ShowS
$cshow :: CacheRetrievalAttempt -> String
show :: CacheRetrievalAttempt -> String
$cshowList :: [CacheRetrievalAttempt] -> ShowS
showList :: [CacheRetrievalAttempt] -> ShowS
Show, CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool
(CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool)
-> (CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool)
-> Eq CacheRetrievalAttempt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool
== :: CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool
$c/= :: CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool
/= :: CacheRetrievalAttempt -> CacheRetrievalAttempt -> Bool
Eq, (forall x. CacheRetrievalAttempt -> Rep CacheRetrievalAttempt x)
-> (forall x. Rep CacheRetrievalAttempt x -> CacheRetrievalAttempt)
-> Generic CacheRetrievalAttempt
forall x. Rep CacheRetrievalAttempt x -> CacheRetrievalAttempt
forall x. CacheRetrievalAttempt -> Rep CacheRetrievalAttempt x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheRetrievalAttempt -> Rep CacheRetrievalAttempt x
from :: forall x. CacheRetrievalAttempt -> Rep CacheRetrievalAttempt x
$cto :: forall x. Rep CacheRetrievalAttempt x -> CacheRetrievalAttempt
to :: forall x. Rep CacheRetrievalAttempt x -> CacheRetrievalAttempt
Generic)

instance ToJSON CacheRetrievalAttempt where
  toJSON :: CacheRetrievalAttempt -> Value
toJSON = Options -> CacheRetrievalAttempt -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

-- | Certain events can obligate the cache to be
-- completely invalidated, or partially or fully preserved.
data CacheEvent
  = Invalidate InvalidationReason
  | Preserve CachePreservationMode
  | RetrievalAttempt CacheRetrievalAttempt
  deriving (Int -> CacheEvent -> ShowS
[CacheEvent] -> ShowS
CacheEvent -> String
(Int -> CacheEvent -> ShowS)
-> (CacheEvent -> String)
-> ([CacheEvent] -> ShowS)
-> Show CacheEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheEvent -> ShowS
showsPrec :: Int -> CacheEvent -> ShowS
$cshow :: CacheEvent -> String
show :: CacheEvent -> String
$cshowList :: [CacheEvent] -> ShowS
showList :: [CacheEvent] -> ShowS
Show, CacheEvent -> CacheEvent -> Bool
(CacheEvent -> CacheEvent -> Bool)
-> (CacheEvent -> CacheEvent -> Bool) -> Eq CacheEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheEvent -> CacheEvent -> Bool
== :: CacheEvent -> CacheEvent -> Bool
$c/= :: CacheEvent -> CacheEvent -> Bool
/= :: CacheEvent -> CacheEvent -> Bool
Eq, (forall x. CacheEvent -> Rep CacheEvent x)
-> (forall x. Rep CacheEvent x -> CacheEvent) -> Generic CacheEvent
forall x. Rep CacheEvent x -> CacheEvent
forall x. CacheEvent -> Rep CacheEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CacheEvent -> Rep CacheEvent x
from :: forall x. CacheEvent -> Rep CacheEvent x
$cto :: forall x. Rep CacheEvent x -> CacheEvent
to :: forall x. Rep CacheEvent x -> CacheEvent
Generic)

instance ToJSON CacheEvent where
  toJSON :: CacheEvent -> Value
toJSON = Options -> CacheEvent -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

data DistanceLimitChange
  = LimitIncreased
  | PathExceededLimit
  deriving (Int -> DistanceLimitChange -> ShowS
[DistanceLimitChange] -> ShowS
DistanceLimitChange -> String
(Int -> DistanceLimitChange -> ShowS)
-> (DistanceLimitChange -> String)
-> ([DistanceLimitChange] -> ShowS)
-> Show DistanceLimitChange
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistanceLimitChange -> ShowS
showsPrec :: Int -> DistanceLimitChange -> ShowS
$cshow :: DistanceLimitChange -> String
show :: DistanceLimitChange -> String
$cshowList :: [DistanceLimitChange] -> ShowS
showList :: [DistanceLimitChange] -> ShowS
Show, DistanceLimitChange -> DistanceLimitChange -> Bool
(DistanceLimitChange -> DistanceLimitChange -> Bool)
-> (DistanceLimitChange -> DistanceLimitChange -> Bool)
-> Eq DistanceLimitChange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistanceLimitChange -> DistanceLimitChange -> Bool
== :: DistanceLimitChange -> DistanceLimitChange -> Bool
$c/= :: DistanceLimitChange -> DistanceLimitChange -> Bool
/= :: DistanceLimitChange -> DistanceLimitChange -> Bool
Eq, (forall x. DistanceLimitChange -> Rep DistanceLimitChange x)
-> (forall x. Rep DistanceLimitChange x -> DistanceLimitChange)
-> Generic DistanceLimitChange
forall x. Rep DistanceLimitChange x -> DistanceLimitChange
forall x. DistanceLimitChange -> Rep DistanceLimitChange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DistanceLimitChange -> Rep DistanceLimitChange x
from :: forall x. DistanceLimitChange -> Rep DistanceLimitChange x
$cto :: forall x. Rep DistanceLimitChange x -> DistanceLimitChange
to :: forall x. Rep DistanceLimitChange x -> DistanceLimitChange
Generic, [DistanceLimitChange] -> Value
[DistanceLimitChange] -> Encoding
DistanceLimitChange -> Bool
DistanceLimitChange -> Value
DistanceLimitChange -> Encoding
(DistanceLimitChange -> Value)
-> (DistanceLimitChange -> Encoding)
-> ([DistanceLimitChange] -> Value)
-> ([DistanceLimitChange] -> Encoding)
-> (DistanceLimitChange -> Bool)
-> ToJSON DistanceLimitChange
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DistanceLimitChange -> Value
toJSON :: DistanceLimitChange -> Value
$ctoEncoding :: DistanceLimitChange -> Encoding
toEncoding :: DistanceLimitChange -> Encoding
$ctoJSONList :: [DistanceLimitChange] -> Value
toJSONList :: [DistanceLimitChange] -> Value
$ctoEncodingList :: [DistanceLimitChange] -> Encoding
toEncodingList :: [DistanceLimitChange] -> Encoding
$comitField :: DistanceLimitChange -> Bool
omitField :: DistanceLimitChange -> Bool
ToJSON)

data DifferentArgument
  = NewSubworld
  | NewTargetType
  | NewWalkabilityContext
  | NewDistanceLimit DistanceLimitChange
  deriving (Int -> DifferentArgument -> ShowS
[DifferentArgument] -> ShowS
DifferentArgument -> String
(Int -> DifferentArgument -> ShowS)
-> (DifferentArgument -> String)
-> ([DifferentArgument] -> ShowS)
-> Show DifferentArgument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DifferentArgument -> ShowS
showsPrec :: Int -> DifferentArgument -> ShowS
$cshow :: DifferentArgument -> String
show :: DifferentArgument -> String
$cshowList :: [DifferentArgument] -> ShowS
showList :: [DifferentArgument] -> ShowS
Show, DifferentArgument -> DifferentArgument -> Bool
(DifferentArgument -> DifferentArgument -> Bool)
-> (DifferentArgument -> DifferentArgument -> Bool)
-> Eq DifferentArgument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DifferentArgument -> DifferentArgument -> Bool
== :: DifferentArgument -> DifferentArgument -> Bool
$c/= :: DifferentArgument -> DifferentArgument -> Bool
/= :: DifferentArgument -> DifferentArgument -> Bool
Eq, (forall x. DifferentArgument -> Rep DifferentArgument x)
-> (forall x. Rep DifferentArgument x -> DifferentArgument)
-> Generic DifferentArgument
forall x. Rep DifferentArgument x -> DifferentArgument
forall x. DifferentArgument -> Rep DifferentArgument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DifferentArgument -> Rep DifferentArgument x
from :: forall x. DifferentArgument -> Rep DifferentArgument x
$cto :: forall x. Rep DifferentArgument x -> DifferentArgument
to :: forall x. Rep DifferentArgument x -> DifferentArgument
Generic, [DifferentArgument] -> Value
[DifferentArgument] -> Encoding
DifferentArgument -> Bool
DifferentArgument -> Value
DifferentArgument -> Encoding
(DifferentArgument -> Value)
-> (DifferentArgument -> Encoding)
-> ([DifferentArgument] -> Value)
-> ([DifferentArgument] -> Encoding)
-> (DifferentArgument -> Bool)
-> ToJSON DifferentArgument
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DifferentArgument -> Value
toJSON :: DifferentArgument -> Value
$ctoEncoding :: DifferentArgument -> Encoding
toEncoding :: DifferentArgument -> Encoding
$ctoJSONList :: [DifferentArgument] -> Value
toJSONList :: [DifferentArgument] -> Value
$ctoEncodingList :: [DifferentArgument] -> Encoding
toEncodingList :: [DifferentArgument] -> Encoding
$comitField :: DifferentArgument -> Bool
omitField :: DifferentArgument -> Bool
ToJSON)

-- | Reasons why we cannot re-use a precomputed path
-- from the cache upon re-invoking the 'Path' command
data CacheRetreivalInapplicability
  = NotCached
  | DifferentArg DifferentArgument
  | PositionOutsidePath
  deriving (Int -> CacheRetreivalInapplicability -> ShowS
[CacheRetreivalInapplicability] -> ShowS
CacheRetreivalInapplicability -> String
(Int -> CacheRetreivalInapplicability -> ShowS)
-> (CacheRetreivalInapplicability -> String)
-> ([CacheRetreivalInapplicability] -> ShowS)
-> Show CacheRetreivalInapplicability
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CacheRetreivalInapplicability -> ShowS
showsPrec :: Int -> CacheRetreivalInapplicability -> ShowS
$cshow :: CacheRetreivalInapplicability -> String
show :: CacheRetreivalInapplicability -> String
$cshowList :: [CacheRetreivalInapplicability] -> ShowS
showList :: [CacheRetreivalInapplicability] -> ShowS
Show, CacheRetreivalInapplicability
-> CacheRetreivalInapplicability -> Bool
(CacheRetreivalInapplicability
 -> CacheRetreivalInapplicability -> Bool)
-> (CacheRetreivalInapplicability
    -> CacheRetreivalInapplicability -> Bool)
-> Eq CacheRetreivalInapplicability
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CacheRetreivalInapplicability
-> CacheRetreivalInapplicability -> Bool
== :: CacheRetreivalInapplicability
-> CacheRetreivalInapplicability -> Bool
$c/= :: CacheRetreivalInapplicability
-> CacheRetreivalInapplicability -> Bool
/= :: CacheRetreivalInapplicability
-> CacheRetreivalInapplicability -> Bool
Eq, (forall x.
 CacheRetreivalInapplicability
 -> Rep CacheRetreivalInapplicability x)
-> (forall x.
    Rep CacheRetreivalInapplicability x
    -> CacheRetreivalInapplicability)
-> Generic CacheRetreivalInapplicability
forall x.
Rep CacheRetreivalInapplicability x
-> CacheRetreivalInapplicability
forall x.
CacheRetreivalInapplicability
-> Rep CacheRetreivalInapplicability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
CacheRetreivalInapplicability
-> Rep CacheRetreivalInapplicability x
from :: forall x.
CacheRetreivalInapplicability
-> Rep CacheRetreivalInapplicability x
$cto :: forall x.
Rep CacheRetreivalInapplicability x
-> CacheRetreivalInapplicability
to :: forall x.
Rep CacheRetreivalInapplicability x
-> CacheRetreivalInapplicability
Generic)

instance ToJSON CacheRetreivalInapplicability where
  toJSON :: CacheRetreivalInapplicability -> Value
toJSON = Options -> CacheRetreivalInapplicability -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
optionsMinimize

-- | Reasons for cache being invalidated
data InvalidationReason
  = TargetEntityAddedOutsidePath
  | TargetEntityRemoved
  | UnwalkableRemoved
  | UnwalkableOntoPath
  | NonexistentRobot
  deriving (Int -> InvalidationReason -> ShowS
[InvalidationReason] -> ShowS
InvalidationReason -> String
(Int -> InvalidationReason -> ShowS)
-> (InvalidationReason -> String)
-> ([InvalidationReason] -> ShowS)
-> Show InvalidationReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidationReason -> ShowS
showsPrec :: Int -> InvalidationReason -> ShowS
$cshow :: InvalidationReason -> String
show :: InvalidationReason -> String
$cshowList :: [InvalidationReason] -> ShowS
showList :: [InvalidationReason] -> ShowS
Show, InvalidationReason -> InvalidationReason -> Bool
(InvalidationReason -> InvalidationReason -> Bool)
-> (InvalidationReason -> InvalidationReason -> Bool)
-> Eq InvalidationReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InvalidationReason -> InvalidationReason -> Bool
== :: InvalidationReason -> InvalidationReason -> Bool
$c/= :: InvalidationReason -> InvalidationReason -> Bool
/= :: InvalidationReason -> InvalidationReason -> Bool
Eq, (forall x. InvalidationReason -> Rep InvalidationReason x)
-> (forall x. Rep InvalidationReason x -> InvalidationReason)
-> Generic InvalidationReason
forall x. Rep InvalidationReason x -> InvalidationReason
forall x. InvalidationReason -> Rep InvalidationReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InvalidationReason -> Rep InvalidationReason x
from :: forall x. InvalidationReason -> Rep InvalidationReason x
$cto :: forall x. Rep InvalidationReason x -> InvalidationReason
to :: forall x. Rep InvalidationReason x -> InvalidationReason
Generic, [InvalidationReason] -> Value
[InvalidationReason] -> Encoding
InvalidationReason -> Bool
InvalidationReason -> Value
InvalidationReason -> Encoding
(InvalidationReason -> Value)
-> (InvalidationReason -> Encoding)
-> ([InvalidationReason] -> Value)
-> ([InvalidationReason] -> Encoding)
-> (InvalidationReason -> Bool)
-> ToJSON InvalidationReason
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: InvalidationReason -> Value
toJSON :: InvalidationReason -> Value
$ctoEncoding :: InvalidationReason -> Encoding
toEncoding :: InvalidationReason -> Encoding
$ctoJSONList :: [InvalidationReason] -> Value
toJSONList :: [InvalidationReason] -> Value
$ctoEncodingList :: [InvalidationReason] -> Encoding
toEncodingList :: [InvalidationReason] -> Encoding
$comitField :: InvalidationReason -> Bool
omitField :: InvalidationReason -> Bool
ToJSON)

emptyPathCache :: PathCaching
emptyPathCache :: PathCaching
emptyPathCache = IntMap PathfindingCache -> RingBuffer CacheLogEntry -> PathCaching
PathCaching IntMap PathfindingCache
forall a. Monoid a => a
mempty (RingBuffer CacheLogEntry -> PathCaching)
-> RingBuffer CacheLogEntry -> PathCaching
forall a b. (a -> b) -> a -> b
$ BufferSize -> RingBuffer CacheLogEntry
forall a. BufferSize -> RingBuffer a
mkRingBuffer (BufferSize -> RingBuffer CacheLogEntry)
-> BufferSize -> RingBuffer CacheLogEntry
forall a b. (a -> b) -> a -> b
$ Int -> BufferSize
Finite Int
maxLogEntries

-- | Shortest paths can either be computed to the nearest entity of
-- a given type or to a specific location.
data PathfindingTarget
  = LocationTarget Location
  | -- | Note: navigation to entities does not benefit from the
    -- distance heuristic optimization of the A* algorithm
    -- (but see #1568)
    EntityTarget EntityName
  deriving ((forall x. PathfindingTarget -> Rep PathfindingTarget x)
-> (forall x. Rep PathfindingTarget x -> PathfindingTarget)
-> Generic PathfindingTarget
forall x. Rep PathfindingTarget x -> PathfindingTarget
forall x. PathfindingTarget -> Rep PathfindingTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathfindingTarget -> Rep PathfindingTarget x
from :: forall x. PathfindingTarget -> Rep PathfindingTarget x
$cto :: forall x. Rep PathfindingTarget x -> PathfindingTarget
to :: forall x. Rep PathfindingTarget x -> PathfindingTarget
Generic, PathfindingTarget -> PathfindingTarget -> Bool
(PathfindingTarget -> PathfindingTarget -> Bool)
-> (PathfindingTarget -> PathfindingTarget -> Bool)
-> Eq PathfindingTarget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathfindingTarget -> PathfindingTarget -> Bool
== :: PathfindingTarget -> PathfindingTarget -> Bool
$c/= :: PathfindingTarget -> PathfindingTarget -> Bool
/= :: PathfindingTarget -> PathfindingTarget -> Bool
Eq, Int -> PathfindingTarget -> ShowS
[PathfindingTarget] -> ShowS
PathfindingTarget -> String
(Int -> PathfindingTarget -> ShowS)
-> (PathfindingTarget -> String)
-> ([PathfindingTarget] -> ShowS)
-> Show PathfindingTarget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathfindingTarget -> ShowS
showsPrec :: Int -> PathfindingTarget -> ShowS
$cshow :: PathfindingTarget -> String
show :: PathfindingTarget -> String
$cshowList :: [PathfindingTarget] -> ShowS
showList :: [PathfindingTarget] -> ShowS
Show, [PathfindingTarget] -> Value
[PathfindingTarget] -> Encoding
PathfindingTarget -> Bool
PathfindingTarget -> Value
PathfindingTarget -> Encoding
(PathfindingTarget -> Value)
-> (PathfindingTarget -> Encoding)
-> ([PathfindingTarget] -> Value)
-> ([PathfindingTarget] -> Encoding)
-> (PathfindingTarget -> Bool)
-> ToJSON PathfindingTarget
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PathfindingTarget -> Value
toJSON :: PathfindingTarget -> Value
$ctoEncoding :: PathfindingTarget -> Encoding
toEncoding :: PathfindingTarget -> Encoding
$ctoJSONList :: [PathfindingTarget] -> Value
toJSONList :: [PathfindingTarget] -> Value
$ctoEncodingList :: [PathfindingTarget] -> Encoding
toEncodingList :: [PathfindingTarget] -> Encoding
$comitField :: PathfindingTarget -> Bool
omitField :: PathfindingTarget -> Bool
ToJSON)

-- | Facilitates lookup of any shortest path to a particular
-- goal cell, given a location that already lies on a
-- shortest path.
newtype TailMap = TailMap (Map Location [Location])
  deriving ((forall x. TailMap -> Rep TailMap x)
-> (forall x. Rep TailMap x -> TailMap) -> Generic TailMap
forall x. Rep TailMap x -> TailMap
forall x. TailMap -> Rep TailMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TailMap -> Rep TailMap x
from :: forall x. TailMap -> Rep TailMap x
$cto :: forall x. Rep TailMap x -> TailMap
to :: forall x. Rep TailMap x -> TailMap
Generic, TailMap -> TailMap -> Bool
(TailMap -> TailMap -> Bool)
-> (TailMap -> TailMap -> Bool) -> Eq TailMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TailMap -> TailMap -> Bool
== :: TailMap -> TailMap -> Bool
$c/= :: TailMap -> TailMap -> Bool
/= :: TailMap -> TailMap -> Bool
Eq, Int -> TailMap -> ShowS
[TailMap] -> ShowS
TailMap -> String
(Int -> TailMap -> ShowS)
-> (TailMap -> String) -> ([TailMap] -> ShowS) -> Show TailMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TailMap -> ShowS
showsPrec :: Int -> TailMap -> ShowS
$cshow :: TailMap -> String
show :: TailMap -> String
$cshowList :: [TailMap] -> ShowS
showList :: [TailMap] -> ShowS
Show)

instance ToJSON TailMap where
  toJSON :: TailMap -> Value
toJSON (TailMap Map Location [Location]
x) = [(Location, [Location])] -> Value
forall a. ToJSON a => a -> Value
toJSON ([(Location, [Location])] -> Value)
-> [(Location, [Location])] -> Value
forall a b. (a -> b) -> a -> b
$ Map Location [Location] -> [(Location, [Location])]
forall k a. Map k a -> [(k, a)]
M.toList Map Location [Location]
x

data CachedPath = CachedPath
  { CachedPath -> NonEmpty Location
originalPath :: NonEmpty Location
  , CachedPath -> TailMap
locations :: TailMap
  -- ^ Fast lookup map of path suffix by
  -- current location
  }
  deriving ((forall x. CachedPath -> Rep CachedPath x)
-> (forall x. Rep CachedPath x -> CachedPath) -> Generic CachedPath
forall x. Rep CachedPath x -> CachedPath
forall x. CachedPath -> Rep CachedPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CachedPath -> Rep CachedPath x
from :: forall x. CachedPath -> Rep CachedPath x
$cto :: forall x. Rep CachedPath x -> CachedPath
to :: forall x. Rep CachedPath x -> CachedPath
Generic, CachedPath -> CachedPath -> Bool
(CachedPath -> CachedPath -> Bool)
-> (CachedPath -> CachedPath -> Bool) -> Eq CachedPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CachedPath -> CachedPath -> Bool
== :: CachedPath -> CachedPath -> Bool
$c/= :: CachedPath -> CachedPath -> Bool
/= :: CachedPath -> CachedPath -> Bool
Eq, Int -> CachedPath -> ShowS
[CachedPath] -> ShowS
CachedPath -> String
(Int -> CachedPath -> ShowS)
-> (CachedPath -> String)
-> ([CachedPath] -> ShowS)
-> Show CachedPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachedPath -> ShowS
showsPrec :: Int -> CachedPath -> ShowS
$cshow :: CachedPath -> String
show :: CachedPath -> String
$cshowList :: [CachedPath] -> ShowS
showList :: [CachedPath] -> ShowS
Show, [CachedPath] -> Value
[CachedPath] -> Encoding
CachedPath -> Bool
CachedPath -> Value
CachedPath -> Encoding
(CachedPath -> Value)
-> (CachedPath -> Encoding)
-> ([CachedPath] -> Value)
-> ([CachedPath] -> Encoding)
-> (CachedPath -> Bool)
-> ToJSON CachedPath
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: CachedPath -> Value
toJSON :: CachedPath -> Value
$ctoEncoding :: CachedPath -> Encoding
toEncoding :: CachedPath -> Encoding
$ctoJSONList :: [CachedPath] -> Value
toJSONList :: [CachedPath] -> Value
$ctoEncodingList :: [CachedPath] -> Encoding
toEncodingList :: [CachedPath] -> Encoding
$comitField :: CachedPath -> Bool
omitField :: CachedPath -> Bool
ToJSON)

-- | A per-robot cache for the @path@ command.
data PathfindingCache = PathfindingCache
  { PathfindingCache -> PathfindingParameters SubworldName
invocationParms :: PathfindingParameters SubworldName
  , PathfindingCache -> WalkabilityContext
walkabilityInfo :: WalkabilityContext
  , PathfindingCache -> Location
targetLoc :: Location
  , PathfindingCache -> CachedPath
cachedPath :: CachedPath
  }
  deriving ((forall x. PathfindingCache -> Rep PathfindingCache x)
-> (forall x. Rep PathfindingCache x -> PathfindingCache)
-> Generic PathfindingCache
forall x. Rep PathfindingCache x -> PathfindingCache
forall x. PathfindingCache -> Rep PathfindingCache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PathfindingCache -> Rep PathfindingCache x
from :: forall x. PathfindingCache -> Rep PathfindingCache x
$cto :: forall x. Rep PathfindingCache x -> PathfindingCache
to :: forall x. Rep PathfindingCache x -> PathfindingCache
Generic, PathfindingCache -> PathfindingCache -> Bool
(PathfindingCache -> PathfindingCache -> Bool)
-> (PathfindingCache -> PathfindingCache -> Bool)
-> Eq PathfindingCache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathfindingCache -> PathfindingCache -> Bool
== :: PathfindingCache -> PathfindingCache -> Bool
$c/= :: PathfindingCache -> PathfindingCache -> Bool
/= :: PathfindingCache -> PathfindingCache -> Bool
Eq, Int -> PathfindingCache -> ShowS
[PathfindingCache] -> ShowS
PathfindingCache -> String
(Int -> PathfindingCache -> ShowS)
-> (PathfindingCache -> String)
-> ([PathfindingCache] -> ShowS)
-> Show PathfindingCache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PathfindingCache -> ShowS
showsPrec :: Int -> PathfindingCache -> ShowS
$cshow :: PathfindingCache -> String
show :: PathfindingCache -> String
$cshowList :: [PathfindingCache] -> ShowS
showList :: [PathfindingCache] -> ShowS
Show, [PathfindingCache] -> Value
[PathfindingCache] -> Encoding
PathfindingCache -> Bool
PathfindingCache -> Value
PathfindingCache -> Encoding
(PathfindingCache -> Value)
-> (PathfindingCache -> Encoding)
-> ([PathfindingCache] -> Value)
-> ([PathfindingCache] -> Encoding)
-> (PathfindingCache -> Bool)
-> ToJSON PathfindingCache
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: PathfindingCache -> Value
toJSON :: PathfindingCache -> Value
$ctoEncoding :: PathfindingCache -> Encoding
toEncoding :: PathfindingCache -> Encoding
$ctoJSONList :: [PathfindingCache] -> Value
toJSONList :: [PathfindingCache] -> Value
$ctoEncodingList :: [PathfindingCache] -> Encoding
toEncodingList :: [PathfindingCache] -> Encoding
$comitField :: PathfindingCache -> Bool
omitField :: PathfindingCache -> Bool
ToJSON)

data PathCaching = PathCaching
  { PathCaching -> IntMap PathfindingCache
_pathCachingRobots :: IntMap PathfindingCache
  -- ^ Keyed by RID
  , PathCaching -> RingBuffer CacheLogEntry
_pathCachingLog :: RingBuffer CacheLogEntry
  -- ^ For diagnostics/testing/debugging
  }
makeLensesNoSigs ''PathCaching

-- | All the RIDs of robots that are storing a cached path that
-- may require invalidation.
pathCachingRobots :: Lens' PathCaching (IntMap PathfindingCache)

-- | Event log for cache invalidation
pathCachingLog :: Lens' PathCaching (RingBuffer CacheLogEntry)