{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Landmarks that are used to specify portal locations
-- and can serve as navigation aids via the `waypoint` command.
--
-- = Waypoint ordering
--
-- The sequence of waypoints of a given name is dictated by criteria in the following order:
--
-- 1. Ordering of structure placements
--    (see implementation of 'Swarm.Game.Scenario.Topography.Structure.mergeStructures');
--    later placements are ordered first.
-- 2. Placement of cells within a map. Map locations go by row-major order
--    (compare to docs for 'Swarm.Game.State.genRobotTemplates').
--
-- TODO (#1366): May be useful to have a mechanism for more
-- precise control of ordering.
module Swarm.Game.Scenario.Topography.Navigation.Waypoint where

import Data.Int (Int32)
import Data.Text qualified as T
import Data.Yaml as Y
import GHC.Generics (Generic)
import Linear (V2 (..))
import Swarm.Game.Location
import Swarm.Game.Scenario.Topography.Placement

-- | Indicates which structure something came from
-- for debugging purposes.
data Originated a = Originated
  { forall a. Originated a -> Maybe Placement
parent :: Maybe Placement
  , forall a. Originated a -> a
value :: a
  }
  deriving (Int -> Originated a -> ShowS
forall a. Show a => Int -> Originated a -> ShowS
forall a. Show a => [Originated a] -> ShowS
forall a. Show a => Originated a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Originated a] -> ShowS
$cshowList :: forall a. Show a => [Originated a] -> ShowS
show :: Originated a -> String
$cshow :: forall a. Show a => Originated a -> String
showsPrec :: Int -> Originated a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Originated a -> ShowS
Show, Originated a -> Originated a -> Bool
forall a. Eq a => Originated a -> Originated a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Originated a -> Originated a -> Bool
$c/= :: forall a. Eq a => Originated a -> Originated a -> Bool
== :: Originated a -> Originated a -> Bool
$c== :: forall a. Eq a => Originated a -> Originated a -> Bool
Eq, forall a b. a -> Originated b -> Originated a
forall a b. (a -> b) -> Originated a -> Originated b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Originated b -> Originated a
$c<$ :: forall a b. a -> Originated b -> Originated a
fmap :: forall a b. (a -> b) -> Originated a -> Originated b
$cfmap :: forall a b. (a -> b) -> Originated a -> Originated b
Functor)

newtype WaypointName = WaypointName T.Text
  deriving (Int -> WaypointName -> ShowS
[WaypointName] -> ShowS
WaypointName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaypointName] -> ShowS
$cshowList :: [WaypointName] -> ShowS
show :: WaypointName -> String
$cshow :: WaypointName -> String
showsPrec :: Int -> WaypointName -> ShowS
$cshowsPrec :: Int -> WaypointName -> ShowS
Show, WaypointName -> WaypointName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaypointName -> WaypointName -> Bool
$c/= :: WaypointName -> WaypointName -> Bool
== :: WaypointName -> WaypointName -> Bool
$c== :: WaypointName -> WaypointName -> Bool
Eq, Eq WaypointName
WaypointName -> WaypointName -> Bool
WaypointName -> WaypointName -> Ordering
WaypointName -> WaypointName -> WaypointName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WaypointName -> WaypointName -> WaypointName
$cmin :: WaypointName -> WaypointName -> WaypointName
max :: WaypointName -> WaypointName -> WaypointName
$cmax :: WaypointName -> WaypointName -> WaypointName
>= :: WaypointName -> WaypointName -> Bool
$c>= :: WaypointName -> WaypointName -> Bool
> :: WaypointName -> WaypointName -> Bool
$c> :: WaypointName -> WaypointName -> Bool
<= :: WaypointName -> WaypointName -> Bool
$c<= :: WaypointName -> WaypointName -> Bool
< :: WaypointName -> WaypointName -> Bool
$c< :: WaypointName -> WaypointName -> Bool
compare :: WaypointName -> WaypointName -> Ordering
$ccompare :: WaypointName -> WaypointName -> Ordering
Ord, forall x. Rep WaypointName x -> WaypointName
forall x. WaypointName -> Rep WaypointName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WaypointName x -> WaypointName
$cfrom :: forall x. WaypointName -> Rep WaypointName x
Generic, Value -> Parser [WaypointName]
Value -> Parser WaypointName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WaypointName]
$cparseJSONList :: Value -> Parser [WaypointName]
parseJSON :: Value -> Parser WaypointName
$cparseJSON :: Value -> Parser WaypointName
FromJSON)

-- | Metadata about a waypoint
data WaypointConfig = WaypointConfig
  { WaypointConfig -> WaypointName
wpName :: WaypointName
  , WaypointConfig -> Bool
wpUnique :: Bool
  -- ^ Enforce global uniqueness of this waypoint
  }
  deriving (Int -> WaypointConfig -> ShowS
[WaypointConfig] -> ShowS
WaypointConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WaypointConfig] -> ShowS
$cshowList :: [WaypointConfig] -> ShowS
show :: WaypointConfig -> String
$cshow :: WaypointConfig -> String
showsPrec :: Int -> WaypointConfig -> ShowS
$cshowsPrec :: Int -> WaypointConfig -> ShowS
Show, WaypointConfig -> WaypointConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WaypointConfig -> WaypointConfig -> Bool
$c/= :: WaypointConfig -> WaypointConfig -> Bool
== :: WaypointConfig -> WaypointConfig -> Bool
$c== :: WaypointConfig -> WaypointConfig -> Bool
Eq)

parseWaypointConfig :: Object -> Parser WaypointConfig
parseWaypointConfig :: Object -> Parser WaypointConfig
parseWaypointConfig Object
v =
  WaypointName -> Bool -> WaypointConfig
WaypointConfig
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unique" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance FromJSON WaypointConfig where
  parseJSON :: Value -> Parser WaypointConfig
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Waypoint Config" Object -> Parser WaypointConfig
parseWaypointConfig

-- |
-- A parent world shouldn't have to know the exact layout of a subworld
-- to specify where exactly a portal will deliver a robot to within the subworld.
-- Therefore, we define named waypoints in the subworld and the parent world
-- must reference them by name, rather than by coordinate.
data Waypoint = Waypoint
  { Waypoint -> WaypointConfig
wpConfig :: WaypointConfig
  , Waypoint -> Location
wpLoc :: Location
  }
  deriving (Int -> Waypoint -> ShowS
[Waypoint] -> ShowS
Waypoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Waypoint] -> ShowS
$cshowList :: [Waypoint] -> ShowS
show :: Waypoint -> String
$cshow :: Waypoint -> String
showsPrec :: Int -> Waypoint -> ShowS
$cshowsPrec :: Int -> Waypoint -> ShowS
Show, Waypoint -> Waypoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Waypoint -> Waypoint -> Bool
$c/= :: Waypoint -> Waypoint -> Bool
== :: Waypoint -> Waypoint -> Bool
$c== :: Waypoint -> Waypoint -> Bool
Eq)

-- | JSON representation is flattened; all keys are at the same level,
-- in contrast with the underlying record.
instance FromJSON Waypoint where
  parseJSON :: Value -> Parser Waypoint
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Waypoint" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    WaypointConfig -> Location -> Waypoint
Waypoint
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Parser WaypointConfig
parseWaypointConfig Object
v
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"loc"

-- | Basically "fmap" for the "Location" field
modifyLocation ::
  (Location -> Location) ->
  Waypoint ->
  Waypoint
modifyLocation :: (Location -> Location) -> Waypoint -> Waypoint
modifyLocation Location -> Location
f (Waypoint WaypointConfig
cfg Location
originalLoc) = WaypointConfig -> Location -> Waypoint
Waypoint WaypointConfig
cfg forall a b. (a -> b) -> a -> b
$ Location -> Location
f Location
originalLoc

-- | Translation by a vector
offsetWaypoint ::
  V2 Int32 ->
  Waypoint ->
  Waypoint
offsetWaypoint :: V2 Int32 -> Waypoint -> Waypoint
offsetWaypoint V2 Int32
locOffset = (Location -> Location) -> Waypoint -> Waypoint
modifyLocation (forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ V2 Int32
locOffset)