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

module Swarm.Game.Scenario.WorldDescription where

import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Text (Text)
import Data.Text qualified as T
import Data.Yaml as Y
import Swarm.Game.Entity
import Swarm.Game.Scenario.Cell
import Swarm.Game.Scenario.RobotLookup
import Swarm.Util.Location
import Swarm.Util.Yaml
import Witch (into)

------------------------------------------------------------
-- World description
------------------------------------------------------------

-- | A world palette maps characters to 'Cell' values.
newtype WorldPalette e = WorldPalette
  {forall e. WorldPalette e -> KeyMap (PCell e)
unPalette :: KeyMap (PCell e)}
  deriving (WorldPalette e -> WorldPalette e -> Bool
forall e. Eq e => WorldPalette e -> WorldPalette e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorldPalette e -> WorldPalette e -> Bool
$c/= :: forall e. Eq e => WorldPalette e -> WorldPalette e -> Bool
== :: WorldPalette e -> WorldPalette e -> Bool
$c== :: forall e. Eq e => WorldPalette e -> WorldPalette e -> Bool
Eq, Int -> WorldPalette e -> ShowS
forall e. Show e => Int -> WorldPalette e -> ShowS
forall e. Show e => [WorldPalette e] -> ShowS
forall e. Show e => WorldPalette e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorldPalette e] -> ShowS
$cshowList :: forall e. Show e => [WorldPalette e] -> ShowS
show :: WorldPalette e -> String
$cshow :: forall e. Show e => WorldPalette e -> String
showsPrec :: Int -> WorldPalette e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> WorldPalette e -> ShowS
Show)

instance FromJSONE (EntityMap, RobotMap) (WorldPalette Entity) where
  parseJSONE :: Value -> ParserE (EntityMap, RobotMap) (WorldPalette Entity)
parseJSONE = forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"palette" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e. KeyMap (PCell e) -> WorldPalette e
WorldPalette forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall e a. FromJSONE e a => Value -> ParserE e a
parseJSONE

-- | A description of a world parsed from a YAML file.
-- This type is parameterized to accommodate Cells that
-- utilize a less stateful Entity type.
data PWorldDescription e = WorldDescription
  { forall e. PWorldDescription e -> Maybe (PCell e)
defaultTerrain :: Maybe (PCell e)
  , forall e. PWorldDescription e -> Bool
offsetOrigin :: Bool
  , forall e. PWorldDescription e -> WorldPalette e
palette :: WorldPalette e
  , forall e. PWorldDescription e -> Location
ul :: Location
  , forall e. PWorldDescription e -> [[PCell e]]
area :: [[PCell e]]
  }
  deriving (PWorldDescription e -> PWorldDescription e -> Bool
forall e.
Eq e =>
PWorldDescription e -> PWorldDescription e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PWorldDescription e -> PWorldDescription e -> Bool
$c/= :: forall e.
Eq e =>
PWorldDescription e -> PWorldDescription e -> Bool
== :: PWorldDescription e -> PWorldDescription e -> Bool
$c== :: forall e.
Eq e =>
PWorldDescription e -> PWorldDescription e -> Bool
Eq, Int -> PWorldDescription e -> ShowS
forall e. Show e => Int -> PWorldDescription e -> ShowS
forall e. Show e => [PWorldDescription e] -> ShowS
forall e. Show e => PWorldDescription e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PWorldDescription e] -> ShowS
$cshowList :: forall e. Show e => [PWorldDescription e] -> ShowS
show :: PWorldDescription e -> String
$cshow :: forall e. Show e => PWorldDescription e -> String
showsPrec :: Int -> PWorldDescription e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> PWorldDescription e -> ShowS
Show)

type WorldDescription = PWorldDescription Entity

instance FromJSONE (EntityMap, RobotMap) WorldDescription where
  parseJSONE :: Value -> ParserE (EntityMap, RobotMap) WorldDescription
parseJSONE = forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"world description" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    WorldPalette Entity
pal <- Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e (Maybe a)
..:? Text
"palette" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= forall e. KeyMap (PCell e) -> WorldPalette e
WorldPalette forall a. Monoid a => a
mempty
    forall e.
Maybe (PCell e)
-> Bool
-> WorldPalette e
-> Location
-> [[PCell e]]
-> PWorldDescription e
WorldDescription
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e (Maybe a)
..:? Text
"default"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"offset" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure WorldPalette Entity
pal
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"upperleft" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE ((Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"map" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
"") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) e.
MonadFail m =>
WorldPalette e -> Text -> m [[PCell e]]
paintMap WorldPalette Entity
pal)

-- | "Paint" a world map using a 'WorldPalette', turning it from a raw
--   string into a nested list of 'Cell' values by looking up each
--   character in the palette, failing if any character in the raw map
--   is not contained in the palette.
paintMap :: MonadFail m => WorldPalette e -> Text -> m [[PCell e]]
paintMap :: forall (m :: * -> *) e.
MonadFail m =>
WorldPalette e -> Text -> m [[PCell e]]
paintMap WorldPalette e
pal = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *}. MonadFail m => Char -> m (PCell e)
toCell forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
 where
  toCell :: Char -> m (PCell e)
toCell Char
c = case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
Key.fromString [Char
c]) (forall e. WorldPalette e -> KeyMap (PCell e)
unPalette WorldPalette e
pal) of
    Maybe (PCell e)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Char not in world palette: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c
    Just PCell e
cell -> forall (m :: * -> *) a. Monad m => a -> m a
return PCell e
cell