{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}
module Swarm.Game.ScenarioInfo (
ScenarioStatus (..),
_NotStarted,
_InProgress,
_Complete,
ScenarioInfo (..),
scenarioPath,
scenarioStatus,
scenarioBestTime,
scenarioBestTicks,
updateScenarioInfoOnQuit,
ScenarioInfoPair,
ScenarioCollection (..),
scenarioCollectionToList,
scenarioItemByPath,
normalizeScenarioPath,
ScenarioItem (..),
scenarioItemName,
_SISingle,
loadScenarios,
loadScenarioInfo,
saveScenarioInfo,
module Swarm.Game.Scenario,
) where
import Control.Algebra (Has)
import Control.Carrier.Lift (Lift, sendIO)
import Control.Carrier.Throw.Either (Throw, runThrow, throwError)
import Control.Lens hiding (from, (<.>))
import Control.Monad (unless, when)
import Data.Aeson (
Options (..),
defaultOptions,
genericParseJSON,
genericToEncoding,
genericToJSON,
)
import Data.Char (isSpace, toLower)
import Data.Function (on)
import Data.List (intercalate, stripPrefix, (\\))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (isJust)
import Data.Text (Text, pack)
import Data.Time (NominalDiffTime, ZonedTime, diffUTCTime, zonedTimeToUTC)
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.Game.Entity
import Swarm.Game.Scenario
import Swarm.Util (dataNotFound, getDataDirSafe, getSwarmSavePath)
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
import Witch (into)
instance Eq ZonedTime where
== :: ZonedTime -> ZonedTime -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC
instance Ord ZonedTime where
<= :: ZonedTime -> ZonedTime -> Bool
(<=) = forall a. Ord a => a -> a -> Bool
(<=) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC
data ScenarioStatus
= NotStarted
| InProgress
{
ScenarioStatus -> ZonedTime
_scenarioStarted :: ZonedTime
,
ScenarioStatus -> NominalDiffTime
_scenarioElapsed :: NominalDiffTime
,
ScenarioStatus -> Integer
_scenarioElapsedTicks :: Integer
}
| Complete
{
_scenarioStarted :: ZonedTime
,
_scenarioElapsed :: NominalDiffTime
,
_scenarioElapsedTicks :: Integer
}
deriving (ScenarioStatus -> ScenarioStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioStatus -> ScenarioStatus -> Bool
$c/= :: ScenarioStatus -> ScenarioStatus -> Bool
== :: ScenarioStatus -> ScenarioStatus -> Bool
$c== :: ScenarioStatus -> ScenarioStatus -> Bool
Eq, Eq ScenarioStatus
ScenarioStatus -> ScenarioStatus -> Bool
ScenarioStatus -> ScenarioStatus -> Ordering
ScenarioStatus -> ScenarioStatus -> ScenarioStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
$cmin :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
max :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
$cmax :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
>= :: ScenarioStatus -> ScenarioStatus -> Bool
$c>= :: ScenarioStatus -> ScenarioStatus -> Bool
> :: ScenarioStatus -> ScenarioStatus -> Bool
$c> :: ScenarioStatus -> ScenarioStatus -> Bool
<= :: ScenarioStatus -> ScenarioStatus -> Bool
$c<= :: ScenarioStatus -> ScenarioStatus -> Bool
< :: ScenarioStatus -> ScenarioStatus -> Bool
$c< :: ScenarioStatus -> ScenarioStatus -> Bool
compare :: ScenarioStatus -> ScenarioStatus -> Ordering
$ccompare :: ScenarioStatus -> ScenarioStatus -> Ordering
Ord, Int -> ScenarioStatus -> ShowS
[ScenarioStatus] -> ShowS
ScenarioStatus -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioStatus] -> ShowS
$cshowList :: [ScenarioStatus] -> ShowS
show :: ScenarioStatus -> FilePath
$cshow :: ScenarioStatus -> FilePath
showsPrec :: Int -> ScenarioStatus -> ShowS
$cshowsPrec :: Int -> ScenarioStatus -> ShowS
Show, ReadPrec [ScenarioStatus]
ReadPrec ScenarioStatus
Int -> ReadS ScenarioStatus
ReadS [ScenarioStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScenarioStatus]
$creadListPrec :: ReadPrec [ScenarioStatus]
readPrec :: ReadPrec ScenarioStatus
$creadPrec :: ReadPrec ScenarioStatus
readList :: ReadS [ScenarioStatus]
$creadList :: ReadS [ScenarioStatus]
readsPrec :: Int -> ReadS ScenarioStatus
$creadsPrec :: Int -> ReadS ScenarioStatus
Read, forall x. Rep ScenarioStatus x -> ScenarioStatus
forall x. ScenarioStatus -> Rep ScenarioStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScenarioStatus x -> ScenarioStatus
$cfrom :: forall x. ScenarioStatus -> Rep ScenarioStatus x
Generic)
instance FromJSON ScenarioStatus where
parseJSON :: Value -> Parser ScenarioStatus
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
scenarioOptions
instance ToJSON ScenarioStatus where
toEncoding :: ScenarioStatus -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
toJSON :: ScenarioStatus -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
scenarioOptions
data ScenarioInfo = ScenarioInfo
{ ScenarioInfo -> FilePath
_scenarioPath :: FilePath
, ScenarioInfo -> ScenarioStatus
_scenarioStatus :: ScenarioStatus
, ScenarioInfo -> ScenarioStatus
_scenarioBestTime :: ScenarioStatus
, ScenarioInfo -> ScenarioStatus
_scenarioBestTicks :: ScenarioStatus
}
deriving (ScenarioInfo -> ScenarioInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioInfo -> ScenarioInfo -> Bool
$c/= :: ScenarioInfo -> ScenarioInfo -> Bool
== :: ScenarioInfo -> ScenarioInfo -> Bool
$c== :: ScenarioInfo -> ScenarioInfo -> Bool
Eq, Eq ScenarioInfo
ScenarioInfo -> ScenarioInfo -> Bool
ScenarioInfo -> ScenarioInfo -> Ordering
ScenarioInfo -> ScenarioInfo -> ScenarioInfo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
$cmin :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
max :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
$cmax :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
>= :: ScenarioInfo -> ScenarioInfo -> Bool
$c>= :: ScenarioInfo -> ScenarioInfo -> Bool
> :: ScenarioInfo -> ScenarioInfo -> Bool
$c> :: ScenarioInfo -> ScenarioInfo -> Bool
<= :: ScenarioInfo -> ScenarioInfo -> Bool
$c<= :: ScenarioInfo -> ScenarioInfo -> Bool
< :: ScenarioInfo -> ScenarioInfo -> Bool
$c< :: ScenarioInfo -> ScenarioInfo -> Bool
compare :: ScenarioInfo -> ScenarioInfo -> Ordering
$ccompare :: ScenarioInfo -> ScenarioInfo -> Ordering
Ord, Int -> ScenarioInfo -> ShowS
[ScenarioInfo] -> ShowS
ScenarioInfo -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioInfo] -> ShowS
$cshowList :: [ScenarioInfo] -> ShowS
show :: ScenarioInfo -> FilePath
$cshow :: ScenarioInfo -> FilePath
showsPrec :: Int -> ScenarioInfo -> ShowS
$cshowsPrec :: Int -> ScenarioInfo -> ShowS
Show, ReadPrec [ScenarioInfo]
ReadPrec ScenarioInfo
Int -> ReadS ScenarioInfo
ReadS [ScenarioInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ScenarioInfo]
$creadListPrec :: ReadPrec [ScenarioInfo]
readPrec :: ReadPrec ScenarioInfo
$creadPrec :: ReadPrec ScenarioInfo
readList :: ReadS [ScenarioInfo]
$creadList :: ReadS [ScenarioInfo]
readsPrec :: Int -> ReadS ScenarioInfo
$creadsPrec :: Int -> ReadS ScenarioInfo
Read, forall x. Rep ScenarioInfo x -> ScenarioInfo
forall x. ScenarioInfo -> Rep ScenarioInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ScenarioInfo x -> ScenarioInfo
$cfrom :: forall x. ScenarioInfo -> Rep ScenarioInfo x
Generic)
instance FromJSON ScenarioInfo where
parseJSON :: Value -> Parser ScenarioInfo
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
scenarioOptions
instance ToJSON ScenarioInfo where
toEncoding :: ScenarioInfo -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
toJSON :: ScenarioInfo -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
scenarioOptions
type ScenarioInfoPair = (Scenario, ScenarioInfo)
scenarioOptions :: Options
scenarioOptions :: Options
scenarioOptions =
Options
defaultOptions
{ fieldLabelModifier :: ShowS
fieldLabelModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
"_scenario")
}
makeLensesWith (lensRules & generateSignatures .~ False) ''ScenarioInfo
scenarioPath :: Lens' ScenarioInfo FilePath
scenarioStatus :: Lens' ScenarioInfo ScenarioStatus
scenarioBestTime :: Lens' ScenarioInfo ScenarioStatus
scenarioBestTicks :: Lens' ScenarioInfo ScenarioStatus
updateScenarioInfoOnQuit :: ZonedTime -> Integer -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnQuit :: ZonedTime -> Integer -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnQuit ZonedTime
z Integer
ticks Bool
completed (ScenarioInfo FilePath
p ScenarioStatus
s ScenarioStatus
bTime ScenarioStatus
bTicks) = case ScenarioStatus
s of
InProgress ZonedTime
start NominalDiffTime
_ Integer
_ ->
let el :: NominalDiffTime
el = (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC) ZonedTime
z ZonedTime
start
cur :: ScenarioStatus
cur = (if Bool
completed then ZonedTime -> NominalDiffTime -> Integer -> ScenarioStatus
Complete else ZonedTime -> NominalDiffTime -> Integer -> ScenarioStatus
InProgress) ZonedTime
start NominalDiffTime
el Integer
ticks
best :: (ScenarioStatus -> a) -> ScenarioStatus -> ScenarioStatus
best ScenarioStatus -> a
f ScenarioStatus
b = case ScenarioStatus
b of
Complete {} | Bool -> Bool
not Bool
completed Bool -> Bool -> Bool
|| ScenarioStatus -> a
f ScenarioStatus
b forall a. Ord a => a -> a -> Bool
<= ScenarioStatus -> a
f ScenarioStatus
cur -> ScenarioStatus
b
InProgress {} | Bool -> Bool
not Bool
completed Bool -> Bool -> Bool
&& ScenarioStatus -> a
f ScenarioStatus
b forall a. Ord a => a -> a -> Bool
> ScenarioStatus -> a
f ScenarioStatus
cur -> ScenarioStatus
b
ScenarioStatus
_ -> ScenarioStatus
cur
in FilePath
-> ScenarioStatus
-> ScenarioStatus
-> ScenarioStatus
-> ScenarioInfo
ScenarioInfo FilePath
p ScenarioStatus
cur (forall {a}.
Ord a =>
(ScenarioStatus -> a) -> ScenarioStatus -> ScenarioStatus
best ScenarioStatus -> NominalDiffTime
_scenarioElapsed ScenarioStatus
bTime) (forall {a}.
Ord a =>
(ScenarioStatus -> a) -> ScenarioStatus -> ScenarioStatus
best ScenarioStatus -> Integer
_scenarioElapsedTicks ScenarioStatus
bTicks)
ScenarioStatus
_ -> forall a. HasCallStack => FilePath -> a
error FilePath
"Logical error: trying to quit scenario which is not in progress!"
data ScenarioItem = SISingle ScenarioInfoPair | SICollection Text ScenarioCollection
deriving (ScenarioItem -> ScenarioItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioItem -> ScenarioItem -> Bool
$c/= :: ScenarioItem -> ScenarioItem -> Bool
== :: ScenarioItem -> ScenarioItem -> Bool
$c== :: ScenarioItem -> ScenarioItem -> Bool
Eq, 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 (ScenarioCollection -> ScenarioCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScenarioCollection -> ScenarioCollection -> Bool
$c/= :: ScenarioCollection -> ScenarioCollection -> Bool
== :: ScenarioCollection -> ScenarioCollection -> Bool
$c== :: ScenarioCollection -> ScenarioCollection -> Bool
Eq, 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 :: ScenarioCollection -> FilePath -> IO FilePath
normalizeScenarioPath :: ScenarioCollection -> FilePath -> IO 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 do
FilePath
canonPath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
Just FilePath
ddir <- FilePath -> IO (Maybe FilePath)
getDataDirSafe FilePath
"."
FilePath
d <- FilePath -> IO FilePath
canonicalizePath FilePath
ddir
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
loadScenarios :: (Has (Lift IO) sig m) => EntityMap -> m (Either Text ScenarioCollection)
loadScenarios :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text ScenarioCollection)
loadScenarios EntityMap
em = forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall a b. (a -> b) -> a -> b
$ do
let p :: FilePath
p = FilePath
"scenarios"
Maybe FilePath
mdataDir <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
getDataDirSafe FilePath
p
case Maybe FilePath
mdataDir of
Maybe FilePath
Nothing -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (FilePath -> IO Text
dataNotFound FilePath
p) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError
Just FilePath
dataDir -> forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em FilePath
dataDir
orderFileName :: FilePath
orderFileName :: FilePath
orderFileName = FilePath
"00-ORDER.txt"
loadScenarioDir ::
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap ->
FilePath ->
m ScenarioCollection
loadScenarioDir :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em 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 a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
FilePath
"Warning: no " forall a. Semigroup a => a -> a -> a
<> FilePath
orderFileName forall a. Semigroup a => a -> a -> a
<> FilePath
" file found in " forall a. Semigroup a => a -> a -> a
<> FilePath
dirName
forall a. Semigroup a => a -> a -> a
<> FilePath
", using alphabetical order"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Bool
True -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
[FilePath]
fs <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
keepYamlOrDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectory FilePath
dir
case Maybe [FilePath]
morder of
Just [FilePath]
order -> do
let missing :: [FilePath]
missing = [FilePath]
fs forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
order
dangling :: [FilePath]
dangling = [FilePath]
order forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
fs
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
missing) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
( FilePath
"Warning: while processing " forall a. Semigroup a => a -> a -> a
<> (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName) forall a. Semigroup a => a -> a -> a
<> FilePath
": files not listed in "
forall a. Semigroup a => a -> a -> a
<> FilePath
orderFileName
forall a. Semigroup a => a -> a -> a
<> FilePath
" will be ignored"
) forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
" - " forall a. Semigroup a => a -> a -> a
<>) [FilePath]
missing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
dangling) forall a b. (a -> b) -> a -> b
$
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
putStr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
unlines forall a b. (a -> b) -> a -> b
$
( FilePath
"Warning: while processing " forall a. Semigroup a => a -> a -> a
<> (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName)
forall a. Semigroup a => a -> a -> a
<> FilePath
": nonexistent files will be ignored"
) forall a. a -> [a] -> [a]
:
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
" - " forall a. Semigroup a => a -> a -> a
<>) [FilePath]
dangling
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]
fs) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [FilePath]
morder
Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
morder' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\FilePath
item -> (FilePath
item,) 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 -> FilePath -> m ScenarioItem
loadScenarioItem EntityMap
em (FilePath
dir FilePath -> ShowS
</> FilePath
item)) [FilePath]
fs
where
keepYamlOrDirectory :: [FilePath] -> [FilePath]
keepYamlOrDirectory = forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> ShowS
takeExtensions FilePath
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath
"", 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 (Lift IO) sig m, Has (Throw Text) sig m) =>
FilePath ->
m ScenarioInfo
loadScenarioInfo :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) 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
$ ScenarioCollection -> FilePath -> IO 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
-> ScenarioStatus
-> ScenarioStatus
-> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted ScenarioStatus
NotStarted ScenarioStatus
NotStarted
else
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
infoPath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> FilePath
prettyPrintParseException) forall (m :: * -> *) a. Monad m => a -> m a
return
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 (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap ->
FilePath ->
m ScenarioItem
loadScenarioItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> FilePath -> m ScenarioItem
loadScenarioItem EntityMap
em 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 (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> FilePath -> m ScenarioCollection
loadScenarioDir EntityMap
em FilePath
path
Bool
False -> do
Scenario
s <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
EntityMap -> FilePath -> m Scenario
loadScenarioFile EntityMap
em FilePath
path
ScenarioInfo
si <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
FilePath -> m ScenarioInfo
loadScenarioInfo FilePath
path
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> ScenarioItem
SISingle (Scenario
s, ScenarioInfo
si)
makePrisms ''ScenarioItem
makePrisms ''ScenarioStatus