{-# 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)
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
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)
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