{-# LANGUAGE DerivingVia #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Stand-in type for an "Entity" for purposes
-- that do not require carrying around the entire state
-- of an Entity.
--
-- Useful for simplified serialization, debugging,
-- and equality checking, particularly for the World Editor.
module Swarm.Game.Scenario.Topography.EntityFacade where

import Control.Lens ((^.))
import Data.Yaml as Y (ToJSON (toJSON))
import Swarm.Game.Display (Display)
import Swarm.Game.Entity qualified as E

-- | This datatype is a lightweight stand-in for the
-- full-fledged "Entity" type without the baggage of all
-- of its other fields.
-- It contains the bare minimum display information
-- for rendering.
data EntityFacade = EntityFacade E.EntityName Display
  deriving (EntityFacade -> EntityFacade -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityFacade -> EntityFacade -> Bool
$c/= :: EntityFacade -> EntityFacade -> Bool
== :: EntityFacade -> EntityFacade -> Bool
$c== :: EntityFacade -> EntityFacade -> Bool
Eq)

-- Note: This instance is used only for the purpose of WorldPalette
instance ToJSON EntityFacade where
  toJSON :: EntityFacade -> Value
toJSON (EntityFacade EntityName
eName Display
_display) = forall a. ToJSON a => a -> Value
toJSON EntityName
eName

mkFacade :: E.Entity -> EntityFacade
mkFacade :: Entity -> EntityFacade
mkFacade Entity
e =
  EntityName -> Display -> EntityFacade
EntityFacade
    (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity EntityName
E.entityName)
    (Entity
e forall s a. s -> Getting a s a -> a
^. Lens' Entity Display
E.entityDisplay)