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

module Swarm.Game.Scenario.Cell (
  PCell (..),
  Cell,
) where

import Control.Lens hiding (from, (<.>))
import Control.Monad (when)
import Control.Monad.Extra (mapMaybeM)
import Data.Text (Text)
import Data.Vector qualified as V
import Data.Yaml as Y
import Swarm.Game.Entity
import Swarm.Game.Scenario.RobotLookup
import Swarm.Game.Terrain
import Swarm.Util.Yaml

------------------------------------------------------------
-- World cells
------------------------------------------------------------

-- | A single cell in a world map, which contains a terrain value,
--   and optionally an entity and robot.
--   It is parameterized on the Entity type to facilitate less
--   stateful versions of the Entity type in rendering scenario data.
data PCell e = Cell
  { forall e. PCell e -> TerrainType
cellTerrain :: TerrainType
  , forall e. PCell e -> Maybe e
cellEntity :: Maybe e
  , forall e. PCell e -> [IndexedTRobot]
cellRobots :: [IndexedTRobot]
  }
  deriving (PCell e -> PCell e -> Bool
forall e. Eq e => PCell e -> PCell e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PCell e -> PCell e -> Bool
$c/= :: forall e. Eq e => PCell e -> PCell e -> Bool
== :: PCell e -> PCell e -> Bool
$c== :: forall e. Eq e => PCell e -> PCell e -> Bool
Eq, Int -> PCell e -> ShowS
forall e. Show e => Int -> PCell e -> ShowS
forall e. Show e => [PCell e] -> ShowS
forall e. Show e => PCell e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PCell e] -> ShowS
$cshowList :: forall e. Show e => [PCell e] -> ShowS
show :: PCell e -> String
$cshow :: forall e. Show e => PCell e -> String
showsPrec :: Int -> PCell e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> PCell e -> ShowS
Show)

-- | A single cell in a world map, which contains a terrain value,
--   and optionally an entity and robot.
type Cell = PCell Entity

-- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'.  The
--   entity and robot, if present, are immediately looked up and
--   converted into 'Entity' and 'TRobot' values.  If they are not
--   found, a parse error results.
instance FromJSONE (EntityMap, RobotMap) Cell where
  parseJSONE :: Value -> ParserE (EntityMap, RobotMap) Cell
parseJSONE = forall e a.
String -> (Array -> ParserE e a) -> Value -> ParserE e a
withArrayE String
"tuple" forall a b. (a -> b) -> a -> b
$ \Array
v -> do
    let tup :: [Value]
tup = forall a. Vector a -> [a]
V.toList Array
v
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
tup) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"palette entry must nonzero length (terrain, optional entity and then robots if any)"

    TerrainType
terr <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON (forall a. [a] -> a
head [Value]
tup)

    Maybe Entity
ent <- case [Value]
tup forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
1 of
      Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just Value
e -> do
        Maybe Text
meName <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @(Maybe Text) Value
e
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserE EntityMap Entity
getEntity) Maybe Text
meName

    let name2rob :: Value -> With (a, RobotMap) Parser (Maybe IndexedTRobot)
name2rob Value
r = do
          Maybe Text
mrName <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @(Maybe Text) Value
r
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserE RobotMap IndexedTRobot
getRobot) Maybe Text
mrName

    [IndexedTRobot]
robs <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM forall {a}.
Value -> With (a, RobotMap) Parser (Maybe IndexedTRobot)
name2rob (forall a. Int -> [a] -> [a]
drop Int
2 [Value]
tup)

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e. TerrainType -> Maybe e -> [IndexedTRobot] -> PCell e
Cell TerrainType
terr Maybe Entity
ent [IndexedTRobot]
robs