{-# LANGUAGE TemplateHaskell #-}
module Swarm.Game.ScenarioInfo (
ScenarioStatus (..),
_NotStarted,
ScenarioInfo (..),
scenarioPath,
scenarioStatus,
CodeSizeDeterminators (CodeSizeDeterminators),
updateScenarioInfoOnFinish,
ScenarioInfoPair,
ScenarioCollection (..),
scenarioCollectionToList,
flatten,
scenarioItemByPath,
normalizeScenarioPath,
ScenarioItem (..),
scenarioItemName,
_SISingle,
loadScenarios,
loadScenarioInfo,
saveScenarioInfo,
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)
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)
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
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)
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
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
"."
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
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
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
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)
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 ()
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
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)
forall (m :: * -> *) a. Monad m => a -> m a
return ScenarioCollection
collection
where
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
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"
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)
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
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
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)
makePrisms ''ScenarioItem
makePrisms ''ScenarioStatus