{-# LANGUAGE TemplateHaskell #-}

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

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

  -- ** Tutorials
  tutorialsDirname,
  getTutorials,

  -- * Loading and saving scenarios
  loadScenarios,
  loadScenarioInfo,
  saveScenarioInfo,
) 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.Failure
import Swarm.Game.ResourceLoading (getDataDirSafe, getSwarmSavePath)
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Status
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
(Int -> ScenarioItem -> ShowS)
-> (ScenarioItem -> FilePath)
-> ([ScenarioItem] -> ShowS)
-> Show ScenarioItem
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScenarioItem -> ShowS
showsPrec :: Int -> ScenarioItem -> ShowS
$cshow :: ScenarioItem -> FilePath
show :: ScenarioItem -> FilePath
$cshowList :: [ScenarioItem] -> ShowS
showList :: [ScenarioItem] -> ShowS
Show)

-- | Retrieve the name of a scenario item.
scenarioItemName :: ScenarioItem -> Text
scenarioItemName :: ScenarioItem -> Text
scenarioItemName (SISingle (Scenario
s, ScenarioInfo
_ss)) = Scenario
s Scenario -> Getting Text Scenario Text -> Text
forall s a. s -> Getting a s a -> a
^. (ScenarioMetadata -> Const Text ScenarioMetadata)
-> Scenario -> Const Text Scenario
Lens' Scenario ScenarioMetadata
scenarioMetadata ((ScenarioMetadata -> Const Text ScenarioMetadata)
 -> Scenario -> Const Text Scenario)
-> ((Text -> Const Text Text)
    -> ScenarioMetadata -> Const Text ScenarioMetadata)
-> Getting Text Scenario Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text)
-> ScenarioMetadata -> Const Text ScenarioMetadata
Lens' ScenarioMetadata 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
(Int -> ScenarioCollection -> ShowS)
-> (ScenarioCollection -> FilePath)
-> ([ScenarioCollection] -> ShowS)
-> Show ScenarioCollection
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScenarioCollection -> ShowS
showsPrec :: Int -> ScenarioCollection -> ShowS
$cshow :: ScenarioCollection -> FilePath
show :: ScenarioCollection -> FilePath
$cshowList :: [ScenarioCollection] -> ShowS
showList :: [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 = [FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
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 = ScenarioCollection -> f ScenarioCollection
forall a. a -> f a
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 (Map FilePath ScenarioItem -> ScenarioCollection)
-> f (Map FilePath ScenarioItem) -> f ScenarioCollection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Map FilePath ScenarioItem)
-> Traversal'
     (Map FilePath ScenarioItem) (IxValue (Map FilePath ScenarioItem))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
Index (Map FilePath ScenarioItem)
s IxValue (Map FilePath ScenarioItem)
-> f (IxValue (Map FilePath ScenarioItem))
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 (Map FilePath ScenarioItem -> ScenarioCollection)
-> f (Map FilePath ScenarioItem) -> f ScenarioCollection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (Map FilePath ScenarioItem)
-> Traversal'
     (Map FilePath ScenarioItem) (IxValue (Map FilePath ScenarioItem))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
Index (Map FilePath ScenarioItem)
d IxValue (Map FilePath ScenarioItem)
-> f (IxValue (Map FilePath ScenarioItem))
ScenarioItem -> f ScenarioItem
inner Map FilePath ScenarioItem
m
   where
    inner :: ScenarioItem -> f ScenarioItem
inner ScenarioItem
si = case ScenarioItem
si of
      SISingle {} -> ScenarioItem -> f ScenarioItem
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScenarioItem
si
      SICollection Text
n' ScenarioCollection
col -> Text -> ScenarioCollection -> ScenarioItem
SICollection Text
n' (ScenarioCollection -> ScenarioItem)
-> f ScenarioCollection -> f ScenarioItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
forall (f :: * -> *).
Applicative f =>
[FilePath]
-> (ScenarioItem -> f ScenarioItem)
-> ScenarioCollection
-> f ScenarioCollection
ixp [FilePath]
xs ScenarioItem -> f ScenarioItem
f ScenarioCollection
col

-- | Subdirectory of the scenarios directory where tutorials are stored.
tutorialsDirname :: FilePath
tutorialsDirname :: FilePath
tutorialsDirname = FilePath
"Tutorials"

-- | Extract just the collection of tutorial scenarios from the entire
--   scenario collection.
getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials :: ScenarioCollection -> ScenarioCollection
getTutorials ScenarioCollection
sc = case FilePath -> Map FilePath ScenarioItem -> Maybe ScenarioItem
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
tutorialsDirname (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
sc) of
  Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection
c
  Maybe ScenarioItem
_ -> FilePath -> ScenarioCollection
forall a. HasCallStack => FilePath -> a
error (FilePath -> ScenarioCollection) -> FilePath -> ScenarioCollection
forall a b. (a -> b) -> a -> b
$ FilePath
"No tutorials exist: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ScenarioCollection -> FilePath
forall a. Show a => a -> FilePath
show ScenarioCollection
sc

-- | 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 Maybe ScenarioItem -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ScenarioItem -> Bool) -> Maybe ScenarioItem -> Bool
forall a b. (a -> b) -> a -> b
$ ScenarioCollection
col ScenarioCollection
-> Getting (First ScenarioItem) ScenarioCollection ScenarioItem
-> Maybe ScenarioItem
forall s a. s -> Getting (First a) s a -> Maybe a
^? FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
path
        then FilePath -> m FilePath
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
        else IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ do
          FilePath
canonPath <- FilePath -> IO FilePath
canonicalizePath FilePath
path
          Either SystemFailure FilePath
eitherDdir <- LiftC IO (Either SystemFailure FilePath)
-> IO (Either SystemFailure FilePath)
forall (m :: * -> *) a. LiftC m a -> m a
runM (LiftC IO (Either SystemFailure FilePath)
 -> IO (Either SystemFailure FilePath))
-> (ThrowC SystemFailure (LiftC IO) FilePath
    -> LiftC IO (Either SystemFailure FilePath))
-> ThrowC SystemFailure (LiftC IO) FilePath
-> IO (Either SystemFailure FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (ThrowC SystemFailure (LiftC IO) FilePath
 -> IO (Either SystemFailure FilePath))
-> ThrowC SystemFailure (LiftC IO) FilePath
-> IO (Either SystemFailure FilePath)
forall a b. (a -> b) -> a -> b
$ AssetData -> FilePath -> ThrowC SystemFailure (LiftC IO) FilePath
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 (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Either SystemFailure FilePath -> FilePath
forall l r. HasCallStack => Either l r -> r
fromRight' Either SystemFailure FilePath
eitherDdir
          let n :: FilePath
n =
                FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath
d FilePath -> ShowS
</> FilePath
"scenarios") FilePath
canonPath
                  Maybe FilePath -> (Maybe FilePath -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& FilePath -> ShowS -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
canonPath ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
pathSeparator))
          FilePath -> IO FilePath
forall a. a -> IO a
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) = Map FilePath ScenarioItem -> [ScenarioItem]
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 Map FilePath ScenarioItem -> FilePath -> ScenarioItem
forall k a. Ord k => Map k a -> k -> a
M.!) (FilePath -> ScenarioItem) -> [FilePath] -> [ScenarioItem]
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) = (ScenarioItem -> [ScenarioInfoPair])
-> [ScenarioItem] -> [ScenarioInfoPair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ScenarioItem -> [ScenarioInfoPair]
flatten ([ScenarioItem] -> [ScenarioInfoPair])
-> [ScenarioItem] -> [ScenarioInfoPair]
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) =>
  ScenarioInputs ->
  m ScenarioCollection
loadScenarios :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> m ScenarioCollection
loadScenarios ScenarioInputs
scenarioInputs = do
  Either SystemFailure FilePath
res <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (ThrowC SystemFailure m FilePath
 -> m (Either SystemFailure FilePath))
-> ThrowC SystemFailure m FilePath
-> m (Either SystemFailure FilePath)
forall a b. (a -> b) -> a -> b
$ AssetData -> FilePath -> ThrowC SystemFailure m FilePath
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
      SystemFailure -> m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn SystemFailure
err
      ScenarioCollection -> m ScenarioCollection
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioCollection -> m ScenarioCollection)
-> ScenarioCollection -> m ScenarioCollection
forall a b. (a -> b) -> a -> b
$ Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
forall a. Monoid a => a
mempty Map FilePath ScenarioItem
forall a. Monoid a => a
mempty
    Right FilePath
dataDir -> ScenarioInputs -> FilePath -> m ScenarioCollection
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m ScenarioCollection
loadScenarioDir ScenarioInputs
scenarioInputs 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 =
  (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> m FilePath -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> m FilePath
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) =>
  ScenarioInputs ->
  FilePath ->
  m ScenarioCollection
loadScenarioDir :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m ScenarioCollection
loadScenarioDir ScenarioInputs
scenarioInputs FilePath
dir = do
  let orderFile :: FilePath
orderFile = FilePath
dir FilePath -> ShowS
</> FilePath
orderFileName
      dirName :: FilePath
dirName = ShowS
takeBaseName FilePath
dir
  Bool
orderExists <- IO Bool -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
orderFile
  Maybe [FilePath]
morder <- case Bool
orderExists of
    Bool
False -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FilePath
dirName FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"Testing") (m () -> m ()) -> (SystemFailure -> m ()) -> SystemFailure -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SystemFailure -> m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn (SystemFailure -> m ()) -> SystemFailure -> m ()
forall a b. (a -> b) -> a -> b
$
        FilePath -> OrderFileWarning -> SystemFailure
OrderFileWarning (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName) OrderFileWarning
NoOrderFile
      Maybe [FilePath] -> m (Maybe [FilePath])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [FilePath]
forall a. Maybe a
Nothing
    Bool
True -> [FilePath] -> Maybe [FilePath]
forall a. a -> Maybe a
Just ([FilePath] -> Maybe [FilePath])
-> m [FilePath] -> m (Maybe [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m [FilePath]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
FilePath -> m [FilePath]
readOrderFile FilePath
orderFile
  [FilePath]
itemPaths <- IO [FilePath] -> m [FilePath]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> IO [FilePath]
keepYamlOrPublicDirectory FilePath
dir ([FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
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 [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
order
          dangling :: [FilePath]
dangling = [FilePath]
order [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
itemPaths

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

      Maybe (NonEmpty FilePath) -> (NonEmpty FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([FilePath] -> Maybe (NonEmpty FilePath)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [FilePath]
dangling) ((NonEmpty FilePath -> m ()) -> m ())
-> (NonEmpty FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
        SystemFailure -> m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn
          (SystemFailure -> m ())
-> (NonEmpty FilePath -> SystemFailure)
-> NonEmpty FilePath
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> OrderFileWarning -> SystemFailure
OrderFileWarning (FilePath
dirName FilePath -> ShowS
</> FilePath
orderFileName)
          (OrderFileWarning -> SystemFailure)
-> (NonEmpty FilePath -> OrderFileWarning)
-> NonEmpty FilePath
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> OrderFileWarning
DanglingFiles
    Maybe [FilePath]
Nothing -> () -> m ()
forall a. a -> m a
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' = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
itemPaths) ([FilePath] -> [FilePath]) -> Maybe [FilePath] -> Maybe [FilePath]
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 <- ScenarioInputs -> FilePath -> m ScenarioItem
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m ScenarioItem
loadScenarioItem ScenarioInputs
scenarioInputs (FilePath
dir FilePath -> ShowS
</> FilePath
filepath)
        (FilePath, ScenarioItem) -> m (FilePath, ScenarioItem)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
filepath, ScenarioItem
item)
  [Either SystemFailure (FilePath, ScenarioItem)]
scenarios <- (FilePath -> m (Either SystemFailure (FilePath, ScenarioItem)))
-> [FilePath] -> m [Either SystemFailure (FilePath, ScenarioItem)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (ThrowC SystemFailure m (FilePath, ScenarioItem)
 -> m (Either SystemFailure (FilePath, ScenarioItem)))
-> (FilePath -> ThrowC SystemFailure m (FilePath, ScenarioItem))
-> FilePath
-> m (Either SystemFailure (FilePath, ScenarioItem))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ThrowC SystemFailure m (FilePath, ScenarioItem)
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) = [Either SystemFailure (FilePath, ScenarioItem)]
-> ([SystemFailure], [(FilePath, ScenarioItem)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either SystemFailure (FilePath, ScenarioItem)]
scenarios
      scenarioMap :: Map FilePath ScenarioItem
scenarioMap = [(FilePath, ScenarioItem)] -> Map FilePath ScenarioItem
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'' = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> Map FilePath ScenarioItem -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map FilePath ScenarioItem
scenarioMap) ([FilePath] -> [FilePath]) -> Maybe [FilePath] -> Maybe [FilePath]
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
  Seq SystemFailure -> m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum w) sig m =>
w -> m ()
add ([SystemFailure] -> Seq SystemFailure
forall a. [a] -> Seq a
Seq.fromList [SystemFailure]
failures) -- Register failed individual scenarios as warnings
  ScenarioCollection -> m ScenarioCollection
forall a. a -> m a
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 = (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((FilePath -> IO Bool) -> [FilePath] -> IO [FilePath])
-> (FilePath -> FilePath -> IO Bool)
-> FilePath
-> [FilePath]
-> IO [FilePath]
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 (FilePath -> IO Bool) -> FilePath -> IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> ShowS
</> FilePath
f
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
      if Bool
isDir
        then Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"_" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f
        else ShowS
takeExtensions FilePath
f FilePath -> FilePath -> Bool
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
</> FilePath -> [FilePath] -> FilePath
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 <- IO FilePath -> m FilePath
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> FilePath -> IO FilePath
forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath (Maybe [FilePath] -> Map FilePath ScenarioItem -> ScenarioCollection
SC Maybe [FilePath]
forall a. Maybe a
Nothing Map FilePath ScenarioItem
forall a. Monoid a => a
mempty) FilePath
p
  FilePath
infoPath <- IO FilePath -> m FilePath
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
scenarioPathToSavePath FilePath
path ShowS -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO FilePath
getSwarmSavePath Bool
False
  Bool
hasInfo <- IO Bool -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
infoPath
  if Bool -> Bool
not Bool
hasInfo
    then do
      ScenarioInfo -> m ScenarioInfo
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioInfo -> m ScenarioInfo) -> ScenarioInfo -> m ScenarioInfo
forall a b. (a -> b) -> a -> b
$
        FilePath -> ScenarioStatus -> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted
    else
      (ParseException -> SystemFailure)
-> ThrowC ParseException m ScenarioInfo -> m ScenarioInfo
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 (LoadingFailure -> SystemFailure)
-> (ParseException -> LoadingFailure)
-> ParseException
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseException -> LoadingFailure
CanNotParseYaml)
        (ThrowC ParseException m ScenarioInfo -> m ScenarioInfo)
-> (IO (Either ParseException ScenarioInfo)
    -> ThrowC ParseException m ScenarioInfo)
-> IO (Either ParseException ScenarioInfo)
-> m ScenarioInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ParseException ScenarioInfo
-> ThrowC ParseException m ScenarioInfo
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither (Either ParseException ScenarioInfo
 -> ThrowC ParseException m ScenarioInfo)
-> (IO (Either ParseException ScenarioInfo)
    -> ThrowC ParseException m (Either ParseException ScenarioInfo))
-> IO (Either ParseException ScenarioInfo)
-> ThrowC ParseException m ScenarioInfo
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either ParseException ScenarioInfo)
-> ThrowC ParseException m (Either ParseException ScenarioInfo)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO)
        (IO (Either ParseException ScenarioInfo) -> m ScenarioInfo)
-> IO (Either ParseException ScenarioInfo) -> m ScenarioInfo
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ParseException ScenarioInfo)
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 ShowS -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO FilePath
getSwarmSavePath Bool
True
  FilePath -> ScenarioInfo -> IO ()
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
  ) =>
  ScenarioInputs ->
  FilePath ->
  m ScenarioItem
loadScenarioItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m ScenarioItem
loadScenarioItem ScenarioInputs
scenarioInputs FilePath
path = do
  Bool
isDir <- IO Bool -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Bool -> m Bool) -> IO Bool -> m Bool
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 (FilePath -> Text) -> ShowS -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
path
  case Bool
isDir of
    Bool
True -> Text -> ScenarioCollection -> ScenarioItem
SICollection Text
collectionName (ScenarioCollection -> ScenarioItem)
-> m ScenarioCollection -> m ScenarioItem
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScenarioInputs -> FilePath -> m ScenarioCollection
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m ScenarioCollection
loadScenarioDir ScenarioInputs
scenarioInputs FilePath
path
    Bool
False -> do
      Scenario
s <- ScenarioInputs -> FilePath -> m Scenario
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> FilePath -> m Scenario
loadScenarioFile ScenarioInputs
scenarioInputs FilePath
path
      Either SystemFailure ScenarioInfo
eitherSi <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (FilePath -> ThrowC SystemFailure m ScenarioInfo
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 -> ScenarioItem -> m ScenarioItem
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioItem -> m ScenarioItem) -> ScenarioItem -> m ScenarioItem
forall a b. (a -> b) -> a -> b
$ ScenarioInfoPair -> ScenarioItem
SISingle (Scenario
s, ScenarioInfo
si)
        Left SystemFailure
warning -> do
          SystemFailure -> m ()
forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn SystemFailure
warning
          ScenarioItem -> m ScenarioItem
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioItem -> m ScenarioItem) -> ScenarioItem -> m ScenarioItem
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