{-# LANGUAGE TemplateHaskell #-}

-- -Wno-orphans is for the Eq/Ord Time instances

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Saving and loading info about scenarios (status, path, etc.) as
-- well as loading recursive scenario collections.
module Swarm.Game.ScenarioInfo (
  -- * Scenario info
  ScenarioStatus (..),
  _NotStarted,
  ScenarioInfo (..),
  scenarioPath,
  scenarioStatus,
  CodeSizeDeterminators (CodeSizeDeterminators),
  updateScenarioInfoOnFinish,
  ScenarioInfoPair,

  -- * Scenario collection
  ScenarioCollection (..),
  scenarioCollectionToList,
  flatten,
  scenarioItemByPath,
  normalizeScenarioPath,
  ScenarioItem (..),
  scenarioItemName,
  _SISingle,

  -- * Loading and saving scenarios
  loadScenarios,
  loadScenarioInfo,
  saveScenarioInfo,

  -- * Re-exports
  module Swarm.Game.Scenario,
) where

import Control.Algebra (Has)
import Control.Carrier.Lift (runM)
import Control.Carrier.Throw.Either (runThrow)
import Control.Effect.Accum (Accum, add)
import Control.Effect.Lift (Lift, sendIO)
import Control.Effect.Throw (Throw, liftEither)
import Control.Lens hiding (from, (<.>))
import Control.Monad (filterM, forM_, when, (<=<))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Data.Char (isSpace)
import Data.Either (partitionEithers)
import Data.Either.Extra (fromRight')
import Data.List (intercalate, isPrefixOf, stripPrefix, (\\))
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isJust)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Data.Text (Text)
import Data.Yaml as Y
import Swarm.Game.Entity
import Swarm.Game.Failure
import Swarm.Game.ResourceLoading (getDataDirSafe, getSwarmSavePath)
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Status
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Util.Effect (warn, withThrow)
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
import Witch (into)

-- ----------------------------------------------------------------------------
-- Scenario Item
-- ----------------------------------------------------------------------------

-- | A scenario item is either a specific scenario, or a collection of
--   scenarios (/e.g./ the scenarios contained in a subdirectory).
data ScenarioItem = SISingle ScenarioInfoPair | SICollection Text ScenarioCollection
  deriving (Int -> ScenarioItem -> ShowS
[ScenarioItem] -> ShowS
ScenarioItem -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioItem] -> ShowS
$cshowList :: [ScenarioItem] -> ShowS
show :: ScenarioItem -> FilePath
$cshow :: ScenarioItem -> FilePath
showsPrec :: Int -> ScenarioItem -> ShowS
$cshowsPrec :: Int -> ScenarioItem -> ShowS
Show)

-- | Retrieve the name of a scenario item.
scenarioItemName :: ScenarioItem -> Text
scenarioItemName :: ScenarioItem -> Text
scenarioItemName (SISingle (Scenario
s, ScenarioInfo
_ss)) = Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario Text
scenarioName
scenarioItemName (SICollection Text
name ScenarioCollection
_) = Text
name

-- | A scenario collection is a tree of scenarios, keyed by name,
--   together with an optional order.
--
--   /Invariant:/ every item in the
--   'scOrder' exists as a key in the 'scMap'.
data ScenarioCollection = SC
  { ScenarioCollection -> Maybe [FilePath]
scOrder :: Maybe [FilePath]
  , ScenarioCollection -> Map FilePath ScenarioItem
scMap :: Map FilePath ScenarioItem
  }
  deriving (Int -> ScenarioCollection -> ShowS
[ScenarioCollection] -> ShowS
ScenarioCollection -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioCollection] -> ShowS
$cshowList :: [ScenarioCollection] -> ShowS
show :: ScenarioCollection -> FilePath
$cshow :: ScenarioCollection -> FilePath
showsPrec :: Int -> ScenarioCollection -> ShowS
$cshowsPrec :: Int -> ScenarioCollection -> ShowS
Show)

-- | Access and modify 'ScenarioItem's in collection based on their path.
scenarioItemByPath :: FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath :: FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
path = forall (f :: * -> *).
Applicative f =>
[FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
ixp [FilePath]
ps
 where
  ps :: [FilePath]
ps = FilePath -> [FilePath]
splitDirectories FilePath
path
  ixp :: (Applicative f) => [String] -> (ScenarioItem -> f ScenarioItem) -> ScenarioCollection -> f ScenarioCollection
  ixp :: forall (f :: * -> *).
Applicative f =>
[FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
ixp [] ScenarioItem -> f ScenarioItem
_ ScenarioCollection
col = forall (f :: * -> *) a. Applicative f => a -> f a
pure ScenarioCollection
col
  ixp [FilePath
s] ScenarioItem -> f ScenarioItem
f (SC Maybe [FilePath]
n Map FilePath ScenarioItem
m) = Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
s ScenarioItem -> f ScenarioItem
f Map FilePath ScenarioItem
m
  ixp (FilePath
d : [FilePath]
xs) ScenarioItem -> f ScenarioItem
f (SC Maybe [FilePath]
n Map FilePath ScenarioItem
m) = Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
n forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
d ScenarioItem -> f ScenarioItem
inner Map FilePath ScenarioItem
m
   where
    inner :: ScenarioItem -> f ScenarioItem
inner ScenarioItem
si = case ScenarioItem
si of
      SISingle {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ScenarioItem
si
      SICollection Text
n' ScenarioCollection
col -> Text -> ScenarioCollection -> ScenarioItem
SICollection Text
n' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *).
Applicative f =>
[FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
ixp [FilePath]
xs ScenarioItem -> f ScenarioItem
f ScenarioCollection
col

-- | Canonicalize a scenario path, making it usable as a unique key.
normalizeScenarioPath ::
  (MonadIO m) =>
  ScenarioCollection ->
  FilePath ->
  m FilePath
normalizeScenarioPath :: forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection
col FilePath
p =
  let path :: FilePath
path = FilePath
p FilePath -> ShowS
-<.> FilePath
"yaml"
   in if forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ScenarioCollection
col forall s a. s -> Getting (First a) s a -> Maybe a
^? FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
path
        then forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
        else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          FilePath
canonPath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
          Either SystemFailure FilePath
eitherDdir <- forall (m :: * -> *) a. LiftC m a -> m a
runM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
Scenarios FilePath
"." -- no way we got this far without data directory
          FilePath
d <- FilePath -> IO FilePath
canonicalizePath forall a b. (a -> b) -> a -> b
$ forall l r. Partial => Either l r -> r
fromRight' Either SystemFailure FilePath
eitherDdir
          let n :: FilePath
n =
                forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath
d FilePath -> ShowS
</> FilePath
"scenarios") FilePath
canonPath
                  forall a b. a -> (a -> b) -> b
& forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
canonPath (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
pathSeparator))
          forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
n

-- | Convert a scenario collection to a list of scenario items.
scenarioCollectionToList :: ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList :: ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList (SC Maybe [FilePath]
Nothing Map FilePath ScenarioItem
m) = forall k a. Map k a -> [a]
M.elems Map FilePath ScenarioItem
m
scenarioCollectionToList (SC (Just [FilePath]
order) Map FilePath ScenarioItem
m) = (Map FilePath ScenarioItem
m forall k a. Ord k => Map k a -> k -> a
M.!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
order

flatten :: ScenarioItem -> [ScenarioInfoPair]
flatten :: ScenarioItem -> [ScenarioInfoPair]
flatten (SISingle ScenarioInfoPair
p) = [ScenarioInfoPair
p]
flatten (SICollection Text
_ ScenarioCollection
c) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScenarioItem -> [ScenarioInfoPair]
flatten forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList ScenarioCollection
c

-- | Load all the scenarios from the scenarios data directory.
loadScenarios ::
  (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
  EntityMap ->
  WorldMap ->
  m ScenarioCollection
loadScenarios :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> m ScenarioCollection
loadScenarios EntityMap
em WorldMap
worldMap = do
  Either SystemFailure FilePath
res <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure forall a b. (a -> b) -> a -> b
$ forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AssetData -> FilePath -> m FilePath
getDataDirSafe AssetData
Scenarios FilePath
"scenarios"
  case Either SystemFailure FilePath
res of
    Left SystemFailure
err -> do
      forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn SystemFailure
err
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
    Right FilePath
dataDir -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em WorldMap
worldMap FilePath
dataDir

-- | The name of the special file which indicates the order of
--   scenarios in a folder.
orderFileName :: FilePath
orderFileName :: FilePath
orderFileName = FilePath
"00-ORDER.txt"

readOrderFile :: (Has (Lift IO) sig m) => FilePath -> m [String]
readOrderFile :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
FilePath -> m [FilePath]
readOrderFile FilePath
orderFile =
  forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines 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 (FilePath -> IO FilePath
readFile FilePath
orderFile)

-- | Recursively load all scenarios from a particular directory, and also load
--   the 00-ORDER file (if any) giving the order for the scenarios.
loadScenarioDir ::
  (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
  EntityMap ->
  WorldMap ->
  FilePath ->
  m ScenarioCollection
loadScenarioDir :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em WorldMap
worldMap FilePath
dir = do
  let orderFile :: FilePath
orderFile = FilePath
dir FilePath -> ShowS
</> FilePath
orderFileName
      dirName :: FilePath
dirName = ShowS
takeBaseName FilePath
dir
  Bool
orderExists <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
orderFile
  Maybe [FilePath]
morder <- case Bool
orderExists of
    Bool
False -> do
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
dirName forall a. Eq a => a -> a -> Bool
/= FilePath
"Testing") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn forall a b. (a -> b) -> a -> b
$
        FilePath -> OrderFileWarning -> SystemFailure
OrderFileWarning (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName) OrderFileWarning
NoOrderFile
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Bool
True -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
FilePath -> m [FilePath]
readOrderFile FilePath
orderFile
  [FilePath]
itemPaths <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO [FilePath]
keepYamlOrPublicDirectory FilePath
dir forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
dir

  case Maybe [FilePath]
morder of
    Just [FilePath]
order -> do
      let missing :: [FilePath]
missing = [FilePath]
itemPaths forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
order
          dangling :: [FilePath]
dangling = [FilePath]
order forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
itemPaths

      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [FilePath]
missing) forall a b. (a -> b) -> a -> b
$
        forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> OrderFileWarning -> SystemFailure
OrderFileWarning (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> OrderFileWarning
MissingFiles

      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [FilePath]
dangling) forall a b. (a -> b) -> a -> b
$
        forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> OrderFileWarning -> SystemFailure
OrderFileWarning (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName)
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> OrderFileWarning
DanglingFiles
    Maybe [FilePath]
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  -- Only keep the files from 00-ORDER.txt that actually exist.
  let morder' :: Maybe [FilePath]
morder' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
itemPaths) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [FilePath]
morder
      loadItem :: FilePath -> m (FilePath, ScenarioItem)
loadItem FilePath
filepath = do
        ScenarioItem
item <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m ScenarioItem
loadScenarioItem EntityMap
em WorldMap
worldMap (FilePath
dir FilePath -> ShowS
</> FilePath
filepath)
        forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
filepath, ScenarioItem
item)
  [Either SystemFailure (FilePath, ScenarioItem)]
scenarios <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Algebra sig m, Member (Throw SystemFailure) sig,
 Member (Accum (Seq SystemFailure)) sig, Member (Lift IO) sig) =>
FilePath -> m (FilePath, ScenarioItem)
loadItem) [FilePath]
itemPaths
  let ([SystemFailure]
failures, [(FilePath, ScenarioItem)]
successes) = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SystemFailure (FilePath, ScenarioItem)]
scenarios
      scenarioMap :: Map FilePath ScenarioItem
scenarioMap = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath, ScenarioItem)]
successes
      -- Now only keep the files that successfully parsed.
      morder'' :: Maybe [FilePath]
morder'' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map FilePath ScenarioItem
scenarioMap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [FilePath]
morder'
      collection :: ScenarioCollection
collection = Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
morder'' Map FilePath ScenarioItem
scenarioMap
  forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum w) sig m =>
w -> m ()
add (forall a. [a] -> Seq a
Seq.fromList [SystemFailure]
failures) -- Register failed individual scenarios as warnings
  forall (m :: * -> *) a. Monad m => a -> m a
return ScenarioCollection
collection
 where
  -- Keep only files which are .yaml files or directories that start
  -- with something other than an underscore.
  keepYamlOrPublicDirectory :: FilePath -> [FilePath] -> IO [FilePath]
keepYamlOrPublicDirectory = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO Bool
isCatalogEntry

  -- Whether the directory or file should be included in the scenario catalog.
  isCatalogEntry :: FilePath -> FilePath -> IO Bool
isCatalogEntry FilePath
d FilePath
f = do
    Bool
isDir <- FilePath -> IO Bool
doesDirectoryExist forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> ShowS
</> FilePath
f
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
      if Bool
isDir
        then Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ FilePath
"_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f
        else ShowS
takeExtensions FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
".yaml"

-- | How to transform scenario path to save path.
scenarioPathToSavePath :: FilePath -> FilePath -> FilePath
scenarioPathToSavePath :: FilePath -> ShowS
scenarioPathToSavePath FilePath
path FilePath
swarmData = FilePath
swarmData FilePath -> ShowS
</> forall a. [a] -> [[a]] -> [a]
Data.List.intercalate FilePath
"_" (FilePath -> [FilePath]
splitDirectories FilePath
path)

-- | Load saved info about played scenario from XDG data directory.
loadScenarioInfo ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  FilePath ->
  m ScenarioInfo
loadScenarioInfo :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m ScenarioInfo
loadScenarioInfo FilePath
p = do
  FilePath
path <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath (Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC forall a. Maybe a
Nothing forall a. Monoid a => a
mempty) FilePath
p
  FilePath
infoPath <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
scenarioPathToSavePath FilePath
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO FilePath
getSwarmSavePath Bool
False
  Bool
hasInfo <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
infoPath
  if Bool -> Bool
not Bool
hasInfo
    then do
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        FilePath -> ScenarioStatus -> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted
    else
      forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (Asset -> FilePath -> LoadingFailure -> SystemFailure
AssetNotLoaded (AssetData -> Asset
Data AssetData
Scenarios) FilePath
infoPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml)
        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 a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
infoPath

-- | Save info about played scenario to XDG data directory.
saveScenarioInfo ::
  FilePath ->
  ScenarioInfo ->
  IO ()
saveScenarioInfo :: FilePath -> ScenarioInfo -> IO ()
saveScenarioInfo FilePath
path ScenarioInfo
si = do
  FilePath
infoPath <- FilePath -> ShowS
scenarioPathToSavePath FilePath
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO FilePath
getSwarmSavePath Bool
True
  forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile FilePath
infoPath ScenarioInfo
si

-- | Load a scenario item (either a scenario, or a subdirectory
--   containing a collection of scenarios) from a particular path.
loadScenarioItem ::
  ( Has (Throw SystemFailure) sig m
  , Has (Accum (Seq SystemFailure)) sig m
  , Has (Lift IO) sig m
  ) =>
  EntityMap ->
  WorldMap ->
  FilePath ->
  m ScenarioItem
loadScenarioItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m ScenarioItem
loadScenarioItem EntityMap
em WorldMap
worldMap FilePath
path = do
  Bool
isDir <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
path
  let collectionName :: Text
collectionName = forall target source. From source target => source -> target
into @Text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName forall a b. (a -> b) -> a -> b
$ FilePath
path
  case Bool
isDir of
    Bool
True -> Text -> ScenarioCollection -> ScenarioItem
SICollection Text
collectionName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em WorldMap
worldMap FilePath
path
    Bool
False -> do
      Scenario
s <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
EntityMap -> WorldMap -> FilePath -> m Scenario
loadScenarioFile EntityMap
em WorldMap
worldMap FilePath
path
      Either SystemFailure ScenarioInfo
eitherSi <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m ScenarioInfo
loadScenarioInfo FilePath
path)
      case Either SystemFailure ScenarioInfo
eitherSi of
        Right ScenarioInfo
si -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> ScenarioItem
SISingle (Scenario
s, ScenarioInfo
si)
        Left SystemFailure
warning -> do
          forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn SystemFailure
warning
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> ScenarioItem
SISingle (Scenario
s, FilePath -> ScenarioStatus -> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted)

------------------------------------------------------------
-- Some lenses + prisms
------------------------------------------------------------

makePrisms ''ScenarioItem
makePrisms ''ScenarioStatus