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

module Swarm.Game.Scenario.RobotLookup where

import Control.Lens hiding (from, (<.>))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Text (Text)
import Swarm.Game.Entity
import Swarm.Game.Robot (TRobot, trobotName)
import Swarm.Util.Yaml

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

-- | 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 Text 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 -> (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 :: String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing :: forall m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
thing Text -> m -> Maybe a
lkup Text
name = do
  m
m <- forall (f :: * -> *) e. Monad f => With e f e
getE
  case Text -> m -> Maybe a
lkup Text
name m
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown " forall a. Semigroup a => a -> a -> a
<> String
thing forall a. Semigroup a => a -> a -> a
<> String
" name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
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 m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
"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 :: Text -> ParserE RobotMap IndexedTRobot
getRobot :: Text -> ParserE RobotMap IndexedTRobot
getRobot = forall m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
"robot" forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup