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

-- |
-- Module      :  Swarm.Game.Scenario
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- 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 (
  -- * Objectives
  Objective,
  objectiveGoal,
  objectiveCondition,

  -- * WorldDescription
  Cell (..),
  WorldDescription (..),
  IndexedTRobot,

  -- * Scenario
  Scenario,

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

  -- * Loading from disk
  loadScenario,
  loadScenarioFile,
  getScenarioPath,
) where

import Control.Algebra (Has)
import Control.Carrier.Lift (Lift, sendIO)
import Control.Carrier.Throw.Either (Throw, throwError)
import Control.Lens hiding (from, (<.>))
import Control.Monad (filterM, when)
import Control.Monad.Extra (mapMaybeM)
import Data.Aeson.Key qualified as Key
import Data.Aeson.KeyMap (KeyMap)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (catMaybes, isNothing, listToMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Vector qualified as V
import Data.Yaml as Y
import GHC.Generics (Generic)
import GHC.Int (Int64)
import Linear.V2
import Swarm.Game.Entity
import Swarm.Game.Recipe
import Swarm.Game.Robot (TRobot, trobotName)
import Swarm.Game.Terrain
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.Util (getDataFileNameSafe, reflow)
import Swarm.Util.Yaml
import System.Directory (doesFileExist)
import System.FilePath ((<.>), (</>))
import Witch (from, into)

------------------------------------------------------------
-- Scenario objectives
------------------------------------------------------------

-- | An objective is a condition to be achieved by a player in a
--   scenario.
data Objective = Objective
  { Objective -> [Text]
_objectiveGoal :: [Text]
  , Objective -> ProcessedTerm
_objectiveCondition :: ProcessedTerm
  }
  deriving (Objective -> Objective -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Objective -> Objective -> Bool
$c/= :: Objective -> Objective -> Bool
== :: Objective -> Objective -> Bool
$c== :: Objective -> Objective -> Bool
Eq, Int -> Objective -> ShowS
[Objective] -> ShowS
Objective -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Objective] -> ShowS
$cshowList :: [Objective] -> ShowS
show :: Objective -> String
$cshow :: Objective -> String
showsPrec :: Int -> Objective -> ShowS
$cshowsPrec :: Int -> Objective -> ShowS
Show, forall x. Rep Objective x -> Objective
forall x. Objective -> Rep Objective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Objective x -> Objective
$cfrom :: forall x. Objective -> Rep Objective x
Generic, [Objective] -> Encoding
[Objective] -> Value
Objective -> Encoding
Objective -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Objective] -> Encoding
$ctoEncodingList :: [Objective] -> Encoding
toJSONList :: [Objective] -> Value
$ctoJSONList :: [Objective] -> Value
toEncoding :: Objective -> Encoding
$ctoEncoding :: Objective -> Encoding
toJSON :: Objective -> Value
$ctoJSON :: Objective -> Value
ToJSON)

makeLensesWith (lensRules & generateSignatures .~ False) ''Objective

-- | An explanation of the goal of the objective, shown to the player
--   during play.  It is represented as a list of paragraphs.
objectiveGoal :: Lens' Objective [Text]

-- | A winning condition for the objective, expressed as a
--   program of type @cmd bool@.  By default, this program will be
--   run to completion every tick (the usual limits on the number
--   of CESK steps per tick do not apply).
objectiveCondition :: Lens' Objective ProcessedTerm

instance FromJSON Objective where
  parseJSON :: Value -> Parser Objective
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"objective" forall a b. (a -> b) -> a -> b
$ \Object
v ->
    [Text] -> ProcessedTerm -> Objective
Objective
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) Text -> Text
reflow (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"goal" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"condition")

------------------------------------------------------------
-- Robot map
------------------------------------------------------------

-- | A robot template paired with its definition's index within
-- the Scenario file
type IndexedTRobot = (Int, TRobot)

-- | A map from names to robots, used to look up robots in scenario
--   descriptions.
type RobotMap = Map Text IndexedTRobot

-- | Create a 'RobotMap' from a list of robot templates.
buildRobotMap :: [TRobot] -> RobotMap
buildRobotMap :: [TRobot] -> RobotMap
buildRobotMap [TRobot]
rs = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
x TRobot
y -> (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' TRobot Text
trobotName TRobot
y, (Int
x, TRobot
y))) [Int
0 ..] [TRobot]
rs

------------------------------------------------------------
-- Lookup utilities
------------------------------------------------------------

-- | Look up a thing by name, throwing a parse error if it is not
--   found.
getThing :: String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing :: forall m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
thing Text -> m -> Maybe a
lkup Text
name = do
  m
m <- forall (f :: * -> *) e. Monad f => With e f e
getE
  case Text -> m -> Maybe a
lkup Text
name m
m of
    Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown " forall a. Semigroup a => a -> a -> a
<> String
thing forall a. Semigroup a => a -> a -> a
<> String
" name: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
name
    Just a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Look up an entity by name in an 'EntityMap', throwing a parse
--   error if it is not found.
getEntity :: Text -> ParserE EntityMap Entity
getEntity :: Text -> ParserE EntityMap Entity
getEntity = forall m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
"entity" Text -> EntityMap -> Maybe Entity
lookupEntityName

-- | Look up a robot by name in a 'RobotMap', throwing a parse error
--   if it is not found.
getRobot :: Text -> ParserE RobotMap IndexedTRobot
getRobot :: Text -> ParserE RobotMap IndexedTRobot
getRobot = forall m a. String -> (Text -> m -> Maybe a) -> Text -> ParserE m a
getThing String
"robot" forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup

------------------------------------------------------------
-- World cells
------------------------------------------------------------

-- | A single cell in a world map, which contains a terrain value,
--   and optionally an entity and robot.
data Cell = Cell
  { Cell -> TerrainType
cellTerrain :: TerrainType
  , Cell -> Maybe Entity
cellEntity :: Maybe Entity
  , Cell -> [IndexedTRobot]
cellRobots :: [IndexedTRobot]
  }
  deriving (Cell -> Cell -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cell -> Cell -> Bool
$c/= :: Cell -> Cell -> Bool
== :: Cell -> Cell -> Bool
$c== :: Cell -> Cell -> Bool
Eq, Int -> Cell -> ShowS
[Cell] -> ShowS
Cell -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cell] -> ShowS
$cshowList :: [Cell] -> ShowS
show :: Cell -> String
$cshow :: Cell -> String
showsPrec :: Int -> Cell -> ShowS
$cshowsPrec :: Int -> Cell -> ShowS
Show)

-- | Parse a tuple such as @[grass, rock, base]@ into a 'Cell'.  The
--   entity and robot, if present, are immediately looked up and
--   converted into 'Entity' and 'TRobot' values.  If they are not
--   found, a parse error results.
instance FromJSONE (EntityMap, RobotMap) Cell where
  parseJSONE :: Value -> ParserE (EntityMap, RobotMap) Cell
parseJSONE = forall e a.
String -> (Array -> ParserE e a) -> Value -> ParserE e a
withArrayE String
"tuple" forall a b. (a -> b) -> a -> b
$ \Array
v -> do
    let tup :: [Value]
tup = forall a. Vector a -> [a]
V.toList Array
v
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
tup) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"palette entry must nonzero length (terrain, optional entity and then robots if any)"

    TerrainType
terr <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON (forall a. [a] -> a
head [Value]
tup)

    Maybe Entity
ent <- case [Value]
tup forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
1 of
      Maybe Value
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just Value
e -> do
        Maybe Text
meName <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @(Maybe Text) Value
e
        forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserE EntityMap Entity
getEntity) Maybe Text
meName

    let name2rob :: Value -> With (a, RobotMap) Parser (Maybe IndexedTRobot)
name2rob Value
r = do
          Maybe Text
mrName <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> Parser a
parseJSON @(Maybe Text) Value
r
          forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParserE RobotMap IndexedTRobot
getRobot) Maybe Text
mrName

    [IndexedTRobot]
robs <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM forall {a}.
Value -> With (a, RobotMap) Parser (Maybe IndexedTRobot)
name2rob (forall a. Int -> [a] -> [a]
drop Int
2 [Value]
tup)

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TerrainType -> Maybe Entity -> [IndexedTRobot] -> Cell
Cell TerrainType
terr Maybe Entity
ent [IndexedTRobot]
robs

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

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

instance FromJSONE (EntityMap, RobotMap) WorldPalette where
  parseJSONE :: Value -> ParserE (EntityMap, RobotMap) WorldPalette
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 KeyMap Cell -> WorldPalette
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.
data WorldDescription = WorldDescription
  { WorldDescription -> Maybe Cell
defaultTerrain :: Maybe Cell
  , WorldDescription -> Bool
offsetOrigin :: Bool
  , WorldDescription -> WorldPalette
palette :: WorldPalette
  , WorldDescription -> V2 Int64
ul :: V2 Int64
  , WorldDescription -> [[Cell]]
area :: [[Cell]]
  }
  deriving (WorldDescription -> WorldDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorldDescription -> WorldDescription -> Bool
$c/= :: WorldDescription -> WorldDescription -> Bool
== :: WorldDescription -> WorldDescription -> Bool
$c== :: WorldDescription -> WorldDescription -> Bool
Eq, Int -> WorldDescription -> ShowS
[WorldDescription] -> ShowS
WorldDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorldDescription] -> ShowS
$cshowList :: [WorldDescription] -> ShowS
show :: WorldDescription -> String
$cshow :: WorldDescription -> String
showsPrec :: Int -> WorldDescription -> ShowS
$cshowsPrec :: Int -> WorldDescription -> ShowS
Show)

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
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
..!= KeyMap Cell -> WorldPalette
WorldPalette forall a. Monoid a => a
mempty
    Maybe Cell
-> Bool -> WorldPalette -> V2 Int64 -> [[Cell]] -> WorldDescription
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
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 a. a -> a -> V2 a
V2 Int64
0 Int64
0)
      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 :: * -> *).
MonadFail m =>
WorldPalette -> Text -> m [[Cell]]
paintMap WorldPalette
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 -> Text -> m [[Cell]]
paintMap :: forall (m :: * -> *).
MonadFail m =>
WorldPalette -> Text -> m [[Cell]]
paintMap WorldPalette
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 Cell
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 Cell
toCell Char
c = case forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup (String -> Key
Key.fromString [Char
c]) (WorldPalette -> KeyMap Cell
unPalette WorldPalette
pal) of
    Maybe Cell
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 Cell
cell -> forall (m :: * -> *) a. Monad m => a -> m a
return Cell
cell

------------------------------------------------------------
-- 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 -> Text
_scenarioDescription :: Text
  , Scenario -> Bool
_scenarioCreative :: Bool
  , Scenario -> Maybe Int
_scenarioSeed :: Maybe Int
  , Scenario -> EntityMap
_scenarioEntities :: EntityMap
  , Scenario -> [Recipe Entity]
_scenarioRecipes :: [Recipe Entity]
  , Scenario -> [Text]
_scenarioKnown :: [Text]
  , Scenario -> WorldDescription
_scenarioWorld :: WorldDescription
  , Scenario -> [TRobot]
_scenarioRobots :: [TRobot]
  , Scenario -> [Objective]
_scenarioObjectives :: [Objective]
  , Scenario -> Maybe ProcessedTerm
_scenarioSolution :: Maybe ProcessedTerm
  , Scenario -> Maybe Int
_scenarioStepsPerTick :: Maybe Int
  }
  deriving (Scenario -> Scenario -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scenario -> Scenario -> Bool
$c/= :: Scenario -> Scenario -> Bool
== :: Scenario -> Scenario -> Bool
$c== :: Scenario -> Scenario -> Bool
Eq, 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)

makeLensesWith (lensRules & generateSignatures .~ False) ''Scenario

instance FromJSONE EntityMap Scenario where
  parseJSONE :: Value -> ParserE EntityMap 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
    EntityMap
em <- forall (f :: * -> *) a e. Functor f => f a -> With e f a
liftE ([Entity] -> EntityMap
buildEntityMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"entities" forall a. Parser (Maybe a) -> a -> Parser a
.!= []))
    -- extend ambient EntityMap with custom entities
    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 => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall target source. From source target => source -> target
into @String forall a b. (a -> b) -> a -> b
$
            Text
"Unknown entities in 'known' list: " forall a. Semigroup a => a -> a -> a
<> 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

      Int
-> Text
-> Maybe Text
-> Text
-> Bool
-> Maybe Int
-> EntityMap
-> [Recipe Entity]
-> [Text]
-> WorldDescription
-> [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
.!= Text
"")
        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. 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 e' e (f :: * -> *) a. (e' -> e) -> With e f a -> With e' f a
localE (,RobotMap
rsMap) (Object
v forall e a. FromJSONE e a => Object -> Text -> ParserE e a
..: Text
"world")
        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 (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 Text

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

-- | 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 starting world for the scenario.
scenarioWorld :: Lens' Scenario WorldDescription

-- | 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 :: FilePath -> IO (Maybe FilePath)
getScenarioPath :: String -> IO (Maybe String)
getScenarioPath String
scenario = do
  Maybe String
libScenario <- String -> IO (Maybe String)
getDataFileNameSafe forall a b. (a -> b) -> a -> b
$ String
"scenarios" String -> ShowS
</> String
scenario
  Maybe String
libScenarioExt <- String -> IO (Maybe String)
getDataFileNameSafe 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 (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 (Lift IO) sig m, Has (Throw Text) sig m) =>
  String ->
  EntityMap ->
  m (Scenario, FilePath)
loadScenario :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
String -> EntityMap -> m (Scenario, String)
loadScenario String
scenario EntityMap
em = do
  Maybe String
mfileName <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
getScenarioPath String
scenario
  case Maybe String
mfileName of
    Maybe String
Nothing -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError @Text forall a b. (a -> b) -> a -> b
$ Text
"Scenario not found: " forall a. Semigroup a => a -> a -> a
<> forall source target. From source target => source -> target
from @String String
scenario
    Just String
fileName -> (,String
fileName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> String -> m Scenario
loadScenarioFile EntityMap
em String
fileName

-- | Load a scenario from a file.
loadScenarioFile ::
  (Has (Lift IO) sig m, Has (Throw Text) sig m) =>
  EntityMap ->
  FilePath ->
  m Scenario
loadScenarioFile :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> String -> m Scenario
loadScenarioFile EntityMap
em String
fileName = do
  Either ParseException Scenario
res <- 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 String
fileName
  case Either ParseException Scenario
res of
    Left ParseException
parseExn -> forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError @Text (forall source target. From source target => source -> target
from @String (ParseException -> String
prettyPrintParseException ParseException
parseExn))
    Right Scenario
c -> forall (m :: * -> *) a. Monad m => a -> m a
return Scenario
c