{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Scenarios are standalone worlds with specific starting and winning
-- conditions, which can be used both for building interactive
-- tutorials and for standalone puzzles and scenarios.
module Swarm.Game.Scenario (
  -- * WorldDescription
  PCell (..),
  Cell,
  PWorldDescription (..),
  WorldDescription,
  IndexedTRobot,

  -- * Scenario
  Scenario (..),

  -- ** Fields
  scenarioVersion,
  scenarioName,
  scenarioAuthor,
  scenarioDescription,
  scenarioCreative,
  scenarioSeed,
  scenarioAttrs,
  scenarioEntities,
  scenarioRecipes,
  scenarioKnown,
  scenarioWorlds,
  scenarioNavigation,
  scenarioRobots,
  scenarioObjectives,
  scenarioSolution,
  scenarioStepsPerTick,

  -- * Loading from disk
  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 ((<.>), (</>))

------------------------------------------------------------
-- Scenario
------------------------------------------------------------

-- | A 'Scenario' contains all the information to describe a
--   scenario.
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
    -- parse custom entities
    [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]

    -- Save the passed in WorldMap for later
    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

    -- Get rid of WorldMap from context locally, and combine EntityMap
    -- with any custom entities parsed above
    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
      -- parse 'known' entity names and make sure they exist
      [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]

      -- parse robots and build RobotMap
      [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")

--------------------------------------------------
-- Lenses

-- | The version number of the scenario schema.  Currently, this
--   should always be 1, but it is ignored.  In the future, this may
--   be used to convert older formats to newer ones, or simply to
--   print a nice error message when we can't read an older format.
scenarioVersion :: Lens' Scenario Int

-- | The name of the scenario.
scenarioName :: Lens' Scenario Text

-- | The author of the scenario.
scenarioAuthor :: Lens' Scenario (Maybe Text)

-- | A high-level description of the scenario, shown /e.g./ in the
--   menu.
scenarioDescription :: Lens' Scenario (Document Syntax)

-- | Whether the scenario should start in creative mode.
scenarioCreative :: Lens' Scenario Bool

-- | The seed used for the random number generator.  If @Nothing@, use
--   a random seed / prompt the user for the seed.
scenarioSeed :: Lens' Scenario (Maybe Int)

-- | Custom attributes defined in the scenario.
scenarioAttrs :: Lens' Scenario [CustomAttr]

-- | Any custom entities used for this scenario.
scenarioEntities :: Lens' Scenario EntityMap

-- | Any custom recipes used in this scenario.
scenarioRecipes :: Lens' Scenario [Recipe Entity]

-- | List of entities that should be considered "known", so robots do
--   not have to scan them.
scenarioKnown :: Lens' Scenario [Text]

-- | The subworlds of the scenario.
-- The "root" subworld shall always be at the head of the list, by construction.
scenarioWorlds :: Lens' Scenario (NonEmpty WorldDescription)

-- | Waypoints and inter-world portals
scenarioNavigation :: Lens' Scenario (Navigation (M.Map SubworldName) Location)

-- | The starting robots for the scenario.  Note this should
--   include the base.
scenarioRobots :: Lens' Scenario [TRobot]

-- | A sequence of objectives for the scenario (if any).
scenarioObjectives :: Lens' Scenario [Objective]

-- | An optional solution of the scenario, expressed as a
--   program of type @cmd a@. This is useful for automated
--   testing of the win condition.
scenarioSolution :: Lens' Scenario (Maybe ProcessedTerm)

-- | Optionally, specify the maximum number of steps each robot may
--   take during a single tick.
scenarioStepsPerTick :: Lens' Scenario (Maybe Int)
------------------------------------------------------------
-- Loading scenarios
------------------------------------------------------------

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)

-- | Load a scenario with a given name from disk, given an entity map
--   to use.  This function is used if a specific scenario is
--   requested on the command line.
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

-- | Load a scenario from a file.
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))