{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Game.Scenario.RobotLookup where

import Control.Lens hiding (from, (<.>))
import Data.Aeson (FromJSON)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Swarm.Game.Entity
import Swarm.Game.Robot (TRobot, trobotName)
import Swarm.Util (failT, quote)
import Swarm.Util.Yaml

------------------------------------------------------------
-- Robot map
------------------------------------------------------------

newtype RobotName = RobotName Text
  deriving (Int -> RobotName -> ShowS
[RobotName] -> ShowS
RobotName -> String
(Int -> RobotName -> ShowS)
-> (RobotName -> String)
-> ([RobotName] -> ShowS)
-> Show RobotName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RobotName -> ShowS
showsPrec :: Int -> RobotName -> ShowS
$cshow :: RobotName -> String
show :: RobotName -> String
$cshowList :: [RobotName] -> ShowS
showList :: [RobotName] -> ShowS
Show, RobotName -> RobotName -> Bool
(RobotName -> RobotName -> Bool)
-> (RobotName -> RobotName -> Bool) -> Eq RobotName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RobotName -> RobotName -> Bool
== :: RobotName -> RobotName -> Bool
$c/= :: RobotName -> RobotName -> Bool
/= :: RobotName -> RobotName -> Bool
Eq, Eq RobotName
Eq RobotName =>
(RobotName -> RobotName -> Ordering)
-> (RobotName -> RobotName -> Bool)
-> (RobotName -> RobotName -> Bool)
-> (RobotName -> RobotName -> Bool)
-> (RobotName -> RobotName -> Bool)
-> (RobotName -> RobotName -> RobotName)
-> (RobotName -> RobotName -> RobotName)
-> Ord RobotName
RobotName -> RobotName -> Bool
RobotName -> RobotName -> Ordering
RobotName -> RobotName -> RobotName
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
$ccompare :: RobotName -> RobotName -> Ordering
compare :: RobotName -> RobotName -> Ordering
$c< :: RobotName -> RobotName -> Bool
< :: RobotName -> RobotName -> Bool
$c<= :: RobotName -> RobotName -> Bool
<= :: RobotName -> RobotName -> Bool
$c> :: RobotName -> RobotName -> Bool
> :: RobotName -> RobotName -> Bool
$c>= :: RobotName -> RobotName -> Bool
>= :: RobotName -> RobotName -> Bool
$cmax :: RobotName -> RobotName -> RobotName
max :: RobotName -> RobotName -> RobotName
$cmin :: RobotName -> RobotName -> RobotName
min :: RobotName -> RobotName -> RobotName
Ord, (forall x. RobotName -> Rep RobotName x)
-> (forall x. Rep RobotName x -> RobotName) -> Generic RobotName
forall x. Rep RobotName x -> RobotName
forall x. RobotName -> Rep RobotName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RobotName -> Rep RobotName x
from :: forall x. RobotName -> Rep RobotName x
$cto :: forall x. Rep RobotName x -> RobotName
to :: forall x. Rep RobotName x -> RobotName
Generic, Maybe RobotName
Value -> Parser [RobotName]
Value -> Parser RobotName
(Value -> Parser RobotName)
-> (Value -> Parser [RobotName])
-> Maybe RobotName
-> FromJSON RobotName
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser RobotName
parseJSON :: Value -> Parser RobotName
$cparseJSONList :: Value -> Parser [RobotName]
parseJSONList :: Value -> Parser [RobotName]
$comittedField :: Maybe RobotName
omittedField :: Maybe RobotName
FromJSON)

-- | A robot template paired with its definition's index within
-- the Scenario file
type IndexedTRobot = (Int, TRobot)

-- | A map from names to robots, used to look up robots in scenario
--   descriptions.
type RobotMap = Map RobotName IndexedTRobot

-- | Create a 'RobotMap' from a list of robot templates.
buildRobotMap :: [TRobot] -> RobotMap
buildRobotMap :: [TRobot] -> RobotMap
buildRobotMap [TRobot]
rs = [(RobotName, IndexedTRobot)] -> RobotMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(RobotName, IndexedTRobot)] -> RobotMap)
-> [(RobotName, IndexedTRobot)] -> RobotMap
forall a b. (a -> b) -> a -> b
$ (Int -> TRobot -> (RobotName, IndexedTRobot))
-> [Int] -> [TRobot] -> [(RobotName, IndexedTRobot)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x TRobot
y -> (Text -> RobotName
RobotName (Text -> RobotName) -> Text -> RobotName
forall a b. (a -> b) -> a -> b
$ Getting Text TRobot Text -> TRobot -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text TRobot Text
Lens' TRobot Text
trobotName TRobot
y, (Int
x, TRobot
y))) [Int
0 ..] [TRobot]
rs

------------------------------------------------------------
-- Lookup utilities
------------------------------------------------------------

-- | Look up a thing by name, throwing a parse error if it is not
--   found.
getThing :: Show k => Text -> (k -> m -> Maybe a) -> k -> ParserE m a
getThing :: forall k m a.
Show k =>
Text -> (k -> m -> Maybe a) -> k -> ParserE m a
getThing Text
thing k -> m -> Maybe a
lkup k
name = do
  m
m <- With m Parser m
forall (f :: * -> *) e. Monad f => With e f e
getE
  case k -> m -> Maybe a
lkup k
name m
m of
    Maybe a
Nothing -> [Text] -> ParserE m a
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown", Text
thing, Text
"name:", Text -> Text
quote (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ k -> String
forall a. Show a => a -> String
show k
name]
    Just a
a -> a -> ParserE m a
forall a. a -> With m Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Look up an entity by name in an 'EntityMap', throwing a parse
--   error if it is not found.
getEntity :: Text -> ParserE EntityMap Entity
getEntity :: Text -> ParserE EntityMap Entity
getEntity = Text
-> (Text -> EntityMap -> Maybe Entity)
-> Text
-> ParserE EntityMap Entity
forall k m a.
Show k =>
Text -> (k -> m -> Maybe a) -> k -> ParserE m a
getThing Text
"entity" Text -> EntityMap -> Maybe Entity
lookupEntityName

-- | Look up a robot by name in a 'RobotMap', throwing a parse error
--   if it is not found.
getRobot :: RobotName -> ParserE RobotMap IndexedTRobot
getRobot :: RobotName -> ParserE RobotMap IndexedTRobot
getRobot = Text
-> (RobotName -> RobotMap -> Maybe IndexedTRobot)
-> RobotName
-> ParserE RobotMap IndexedTRobot
forall k m a.
Show k =>
Text -> (k -> m -> Maybe a) -> k -> ParserE m a
getThing Text
"robot" RobotName -> RobotMap -> Maybe IndexedTRobot
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup