{-# 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RobotName] -> ShowS
$cshowList :: [RobotName] -> ShowS
show :: RobotName -> String
$cshow :: RobotName -> String
showsPrec :: Int -> RobotName -> ShowS
$cshowsPrec :: Int -> RobotName -> ShowS
Show, RobotName -> RobotName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotName -> RobotName -> Bool
$c/= :: RobotName -> RobotName -> Bool
== :: RobotName -> RobotName -> Bool
$c== :: RobotName -> RobotName -> Bool
Eq, Eq 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
min :: RobotName -> RobotName -> RobotName
$cmin :: RobotName -> RobotName -> RobotName
max :: RobotName -> RobotName -> RobotName
$cmax :: RobotName -> RobotName -> RobotName
>= :: RobotName -> RobotName -> Bool
$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
compare :: RobotName -> RobotName -> Ordering
$ccompare :: RobotName -> RobotName -> Ordering
Ord, 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
$cto :: forall x. Rep RobotName x -> RobotName
$cfrom :: forall x. RobotName -> Rep RobotName x
Generic, Value -> Parser [RobotName]
Value -> Parser RobotName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RobotName]
$cparseJSONList :: Value -> Parser [RobotName]
parseJSON :: Value -> Parser RobotName
$cparseJSON :: Value -> Parser 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 = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x TRobot
y -> (Text -> RobotName
RobotName forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 <- forall (f :: * -> *) e. Monad f => With e f e
getE
  case k -> m -> Maybe a
lkup k
name m
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown", Text
thing, Text
"name:", Text -> Text
quote forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show k
name]
    Just a
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 = 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 = forall k m a.
Show k =>
Text -> (k -> m -> Maybe a) -> k -> ParserE m a
getThing Text
"robot" forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup