{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Swarm.Game.Scenario (
PCell (..),
Cell,
PWorldDescription (..),
WorldDescription,
IndexedTRobot,
Scenario (..),
scenarioVersion,
scenarioName,
scenarioAuthor,
scenarioDescription,
scenarioCreative,
scenarioSeed,
scenarioAttrs,
scenarioEntities,
scenarioRecipes,
scenarioKnown,
scenarioWorlds,
scenarioNavigation,
scenarioRobots,
scenarioObjectives,
scenarioSolution,
scenarioStepsPerTick,
loadScenario,
loadScenarioFile,
getScenarioPath,
loadStandaloneScenario,
) where
import Control.Arrow ((&&&))
import Control.Carrier.Throw.Either (runThrow)
import Control.Effect.Lift (Lift, sendIO)
import Control.Effect.Throw
import Control.Lens hiding (from, (.=), (<.>))
import Control.Monad (filterM, unless, (<=<))
import Data.Aeson
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (catMaybes, isNothing, listToMaybe)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Game.Entity
import Swarm.Game.Failure
import Swarm.Game.Location
import Swarm.Game.Recipe
import Swarm.Game.ResourceLoading (getDataFileNameSafe)
import Swarm.Game.Robot (TRobot)
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Validation
import Swarm.Game.Scenario.RobotLookup
import Swarm.Game.Scenario.Style
import Swarm.Game.Scenario.Topography.Cell
import Swarm.Game.Scenario.Topography.Navigation.Portal
import Swarm.Game.Scenario.Topography.Structure qualified as Structure
import Swarm.Game.Scenario.Topography.WorldDescription
import Swarm.Game.Universe
import Swarm.Game.World.Load (loadWorlds)
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.Language.Pretty (prettyText)
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown (Document)
import Swarm.Util (binTuples, failT)
import Swarm.Util.Effect (ignoreWarnings, throwToMaybe, withThrow)
import Swarm.Util.Lens (makeLensesNoSigs)
import Swarm.Util.Yaml
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
data Scenario = Scenario
{ Scenario -> Int
_scenarioVersion :: Int
, Scenario -> Text
_scenarioName :: Text
, Scenario -> Maybe Text
_scenarioAuthor :: Maybe Text
, Scenario -> Document Syntax
_scenarioDescription :: Document Syntax
, Scenario -> Bool
_scenarioCreative :: Bool
, Scenario -> Maybe Int
_scenarioSeed :: Maybe Int
, Scenario -> [CustomAttr]
_scenarioAttrs :: [CustomAttr]
, Scenario -> EntityMap
_scenarioEntities :: EntityMap
, Scenario -> [Recipe Entity]
_scenarioRecipes :: [Recipe Entity]
, Scenario -> [Text]
_scenarioKnown :: [Text]
, Scenario -> NonEmpty WorldDescription
_scenarioWorlds :: NonEmpty WorldDescription
, Scenario -> Navigation (Map SubworldName) Location
_scenarioNavigation :: Navigation (M.Map SubworldName) Location
, Scenario -> [TRobot]
_scenarioRobots :: [TRobot]
, Scenario -> [Objective]
_scenarioObjectives :: [Objective]
, Scenario -> Maybe ProcessedTerm
_scenarioSolution :: Maybe ProcessedTerm
, Scenario -> Maybe Int
_scenarioStepsPerTick :: Maybe Int
}
deriving (Int -> Scenario -> ShowS
[Scenario] -> ShowS
Scenario -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scenario] -> ShowS
$cshowList :: [Scenario] -> ShowS
show :: Scenario -> String
$cshow :: Scenario -> String
showsPrec :: Int -> Scenario -> ShowS
$cshowsPrec :: Int -> Scenario -> ShowS
Show)
makeLensesNoSigs ''Scenario
instance FromJSONE (EntityMap, WorldMap) Scenario where
parseJSONE :: Value -> ParserE (EntityMap, WorldMap) Scenario
parseJSONE = forall e a.
String -> (Object -> ParserE e a) -> Value -> ParserE e a
withObjectE String
"scenario" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
[Entity]
emRaw <- 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
"entities" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
EntityMap
em <- case forall a. Identity a -> a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Throw LoadingFailure) sig m =>
[Entity] -> m EntityMap
buildEntityMap [Entity]
emRaw of
Right EntityMap
x -> forall (m :: * -> *) a. Monad m => a -> m a
return EntityMap
x
Left LoadingFailure
x -> forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [forall a. PrettyPrec a => a -> Text
prettyText @LoadingFailure LoadingFailure
x]
WorldMap
worldMap <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e. Monad f => With e f e
getE
forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall e (f :: * -> *) a.
Semigroup e =>
e -> With e f a -> With e f a
withE EntityMap
em forall a b. (a -> b) -> a -> b
$ do
[Text]
known <- 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
"known" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
EntityMap
em' <- forall (f :: * -> *) e. Monad f => With e f e
getE
case forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> EntityMap -> Maybe Entity
`lookupEntityName` EntityMap
em')) [Text]
known of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Text]
unk -> forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT [Text
"Unknown entities in 'known' list:", Text -> [Text] -> Text
T.intercalate Text
", " [Text]
unk]
[TRobot]
rs <- Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e a
..: Text
"robots"
let rsMap :: RobotMap
rsMap = [TRobot] -> RobotMap
buildRobotMap [TRobot]
rs
[NamedStructure (Maybe (PCell Entity))]
rootLevelSharedStructures :: Structure.InheritedStructureDefs <-
forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (,RobotMap
rsMap) forall a b. (a -> b) -> a -> b
$
Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e (Maybe a)
..:? Text
"structures" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
NonEmpty WorldDescription
allWorlds <- forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (WorldMap
worldMap,[NamedStructure (Maybe (PCell Entity))]
rootLevelSharedStructures,,RobotMap
rsMap) forall a b. (a -> b) -> a -> b
$ do
WorldDescription
rootWorld <- Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e a
..: Text
"world"
[WorldDescription]
subworlds <- Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e (Maybe a)
..:? Text
"subworlds" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WorldDescription
rootWorld forall a. a -> [a] -> NonEmpty a
:| [WorldDescription]
subworlds
let worldsByName :: Map SubworldName (NonEmpty WorldDescription)
worldsByName = forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall e. PWorldDescription e -> SubworldName
worldName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) NonEmpty WorldDescription
allWorlds
dupedNames :: [SubworldName]
dupedNames = forall k a. Map k a -> [k]
M.keys forall a b. (a -> b) -> a -> b
$ forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) Map SubworldName (NonEmpty WorldDescription)
worldsByName
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SubworldName]
dupedNames) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => [Text] -> m a
failT
[ Text
"Subworld names are not unique:"
, Text -> [Text] -> Text
T.intercalate Text
", " forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map SubworldName -> Text
renderWorldName [SubworldName]
dupedNames
]
let mergedWaypoints :: Map SubworldName WaypointMap
mergedWaypoints =
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall e. PWorldDescription e -> SubworldName
worldName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (additionalDimension :: * -> *) portalExitLoc.
Navigation additionalDimension portalExitLoc
-> additionalDimension WaypointMap
waypoints forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. PWorldDescription e -> Navigation Identity WaypointName
navigation) forall a b. (a -> b) -> a -> b
$
forall a. NonEmpty a -> [a]
NE.toList NonEmpty WorldDescription
allWorlds
Map (Cosmic Location) (AnnotatedDestination Location)
mergedPortals <-
forall (m :: * -> *).
MonadFail m =>
Navigation (Map SubworldName) WaypointName
-> m (Map (Cosmic Location) (AnnotatedDestination Location))
validatePortals
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (additionalDimension :: * -> *) portalExitLoc.
additionalDimension WaypointMap
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
-> Navigation additionalDimension portalExitLoc
Navigation Map SubworldName WaypointMap
mergedWaypoints
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (additionalDimension :: * -> *) portalExitLoc.
Navigation additionalDimension portalExitLoc
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
portals forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. PWorldDescription e -> Navigation Identity WaypointName
navigation)
forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty WorldDescription
allWorlds
let mergedNavigation :: Navigation (Map SubworldName) Location
mergedNavigation = forall (additionalDimension :: * -> *) portalExitLoc.
additionalDimension WaypointMap
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
-> Navigation additionalDimension portalExitLoc
Navigation Map SubworldName WaypointMap
mergedWaypoints Map (Cosmic Location) (AnnotatedDestination Location)
mergedPortals
Int
-> Text
-> Maybe Text
-> Document Syntax
-> Bool
-> Maybe Int
-> [CustomAttr]
-> EntityMap
-> [Recipe Entity]
-> [Text]
-> NonEmpty WorldDescription
-> Navigation (Map SubworldName) Location
-> [TRobot]
-> [Objective]
-> Maybe ProcessedTerm
-> Maybe Int
-> Scenario
Scenario
forall (f :: * -> *) a b. Functor 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 a
.: Key
"version")
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 a
.: Key
"name")
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
"author")
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
"description" forall a. Parser (Maybe a) -> a -> Parser a
.!= Document Syntax
"")
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
"creative" 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 e. Functor f => f a -> With e f a
liftE (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"seed")
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
"attrs" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure EntityMap
em
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e (Maybe a)
..:? Text
"recipes" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
..!= []
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text]
known
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty WorldDescription
allWorlds
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Navigation (Map SubworldName) Location
mergedNavigation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure [TRobot]
rs
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
"objectives" forall a. Parser (Maybe a) -> a -> Parser a
.!= []) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadFail m => [Objective] -> m [Objective]
validateObjectives)
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
"solution")
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
"stepsPerTick")
scenarioVersion :: Lens' Scenario Int
scenarioName :: Lens' Scenario Text
scenarioAuthor :: Lens' Scenario (Maybe Text)
scenarioDescription :: Lens' Scenario (Document Syntax)
scenarioCreative :: Lens' Scenario Bool
scenarioSeed :: Lens' Scenario (Maybe Int)
scenarioAttrs :: Lens' Scenario [CustomAttr]
scenarioEntities :: Lens' Scenario EntityMap
scenarioRecipes :: Lens' Scenario [Recipe Entity]
scenarioKnown :: Lens' Scenario [Text]
scenarioWorlds :: Lens' Scenario (NonEmpty WorldDescription)
scenarioNavigation :: Lens' Scenario (Navigation (M.Map SubworldName) Location)
scenarioRobots :: Lens' Scenario [TRobot]
scenarioObjectives :: Lens' Scenario [Objective]
scenarioSolution :: Lens' Scenario (Maybe ProcessedTerm)
scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
getScenarioPath ::
(Has (Lift IO) sig m) =>
FilePath ->
m (Maybe FilePath)
getScenarioPath :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
String -> m (Maybe String)
getScenarioPath String
scenario = do
Maybe String
libScenario <- forall e (m :: * -> *) a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe @SystemFailure forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Scenarios forall a b. (a -> b) -> a -> b
$ String
"scenarios" String -> ShowS
</> String
scenario
Maybe String
libScenarioExt <- forall e (m :: * -> *) a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe @SystemFailure forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> String -> m String
getDataFileNameSafe AssetData
Scenarios forall a b. (a -> b) -> a -> b
$ String
"scenarios" String -> ShowS
</> String
scenario String -> ShowS
<.> String
"yaml"
let candidates :: [String]
candidates = forall a. [Maybe a] -> [a]
catMaybes [forall a. a -> Maybe a
Just String
scenario, Maybe String
libScenarioExt, Maybe String
libScenario]
forall a. [a] -> Maybe a
listToMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist [String]
candidates)
loadScenario ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath ->
EntityMap ->
WorldMap ->
m (Scenario, FilePath)
loadScenario :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> EntityMap -> WorldMap -> m (Scenario, String)
loadScenario String
scenario EntityMap
em WorldMap
worldMap = do
Maybe String
mfileName <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
String -> m (Maybe String)
getScenarioPath String
scenario
String
fileName <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall a b. (a -> b) -> a -> b
$ String -> SystemFailure
ScenarioNotFound String
scenario) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
mfileName
(,String
fileName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> String -> m Scenario
loadScenarioFile EntityMap
em WorldMap
worldMap String
fileName
loadScenarioFile ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap ->
WorldMap ->
FilePath ->
m Scenario
loadScenarioFile :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> String -> m Scenario
loadScenarioFile EntityMap
em WorldMap
worldMap String
fileName =
(forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow ParseException -> SystemFailure
adaptError forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO)) forall a b. (a -> b) -> a -> b
$
forall e a.
FromJSONE e a =>
e -> String -> IO (Either ParseException a)
decodeFileEitherE (EntityMap
em, WorldMap
worldMap) String
fileName
where
adaptError :: ParseException -> SystemFailure
adaptError = Asset -> String -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
Scenarios) String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml
loadStandaloneScenario ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath ->
m (Scenario, (WorldMap, EntityMap, [Recipe Entity]))
loadStandaloneScenario :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> m (Scenario, (WorldMap, EntityMap, [Recipe Entity]))
loadStandaloneScenario String
fp = do
EntityMap
entities <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m EntityMap
loadEntities
[Recipe Entity]
recipes <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> m [Recipe Entity]
loadRecipes EntityMap
entities
WorldMap
worlds <- forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
AccumC e m a -> m a
ignoreWarnings @(Seq SystemFailure) forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> m WorldMap
loadWorlds EntityMap
entities
Scenario
scene <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> EntityMap -> WorldMap -> m (Scenario, String)
loadScenario String
fp EntityMap
entities WorldMap
worlds
forall (m :: * -> *) a. Monad m => a -> m a
return (Scenario
scene, (WorldMap
worlds, EntityMap
entities, [Recipe Entity]
recipes))