RobotLookup.hs

{-# 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 (Show, Eq, Ord, Generic, 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 rs = M.fromList $ zipWith (\x y -> (RobotName $ view trobotName y, (x, y))) [0 ..] 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 thing lkup name = do
  m <- getE
  case lkup name m of
    Nothing -> failT ["Unknown", thing, "name:", quote $ T.pack $ show name]
    Just a -> return 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 = getThing "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 = getThing "robot" M.lookup