{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

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

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

  -- ** 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_, void, 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.Map.Ordered (OMap)
import Data.Map.Ordered qualified as OM
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.Failure
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Status
import Swarm.ResourceLoading (getDataDirSafe, getSwarmSavePath)
import Swarm.Util (lookupEither)
import Swarm.Util.Effect (warn, withThrow)
import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
import System.FilePath (pathSeparator, splitDirectories, takeBaseName, takeExtensions, (-<.>), (</>))
import System.IO (readFile')
import System.IO.Error (catchIOError)
import Witch (into)

------------------------------------------------------------

-- * Utilities

-- | Given an ordered list of keys and a map, return a partition consisting of:
-- * Left: the keys that were not present
-- * Right: the retrievable key-value pairs in corresponding order to the provided keys
lookupInOrder :: Ord k => Map k v -> [k] -> ([k], [(k, v)])
lookupInOrder :: forall k v. Ord k => Map k v -> [k] -> ([k], [(k, v)])
lookupInOrder Map k v
m = [Either k (k, v)] -> ([k], [(k, v)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either k (k, v)] -> ([k], [(k, v)]))
-> ([k] -> [Either k (k, v)]) -> [k] -> ([k], [(k, v)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> Either k (k, v)) -> [k] -> [Either k (k, v)]
forall a b. (a -> b) -> [a] -> [b]
map k -> Either k (k, v)
produceKeyValuePair
 where
  produceKeyValuePair :: k -> Either k (k, v)
produceKeyValuePair k
k = (k, Either k v) -> Either k (k, v)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => (k, f a) -> f (k, a)
sequenceA (k
k, k -> Map k v -> Either k v
forall k v. Ord k => k -> Map k v -> Either k v
lookupEither k
k Map k v
m)

-- ** Ordered Map utilities

type instance Index (OMap k a) = k
type instance IxValue (OMap k a) = a

-- | Adapted from:
-- https://hackage.haskell.org/package/lens-5.3.4/docs/src/Control.Lens.At.html#line-319
instance Ord k => Ixed (OMap k a) where
  ix :: Index (OMap k a) -> Traversal' (OMap k a) (IxValue (OMap k a))
ix Index (OMap k a)
k IxValue (OMap k a) -> f (IxValue (OMap k a))
f OMap k a
m = case k -> OMap k a -> Maybe a
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup k
Index (OMap k a)
k OMap k a
m of
    Just a
v -> IxValue (OMap k a) -> f (IxValue (OMap k a))
f a
IxValue (OMap k a)
v f a -> (a -> OMap k a) -> f (OMap k a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \a
v' -> (Maybe a -> Maybe a) -> k -> OMap k a -> OMap k a
forall k v.
Ord k =>
(Maybe v -> Maybe v) -> k -> OMap k v -> OMap k v
OM.alter (Maybe a -> Maybe a -> Maybe a
forall a b. a -> b -> a
const (Maybe a -> Maybe a -> Maybe a) -> Maybe a -> Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
v') k
Index (OMap k a)
k OMap k a
m
    Maybe a
Nothing -> OMap k a -> f (OMap k a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OMap k a
m

-- | Strangely, an 'elems' function is missing from the 'OMap' API.
orderedElems :: OMap k a -> [a]
orderedElems :: forall k a. OMap k a -> [a]
orderedElems = ((k, a) -> a) -> [(k, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (k, a) -> a
forall a b. (a, b) -> b
snd ([(k, a)] -> [a]) -> (OMap k a -> [(k, a)]) -> OMap k a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap k a -> [(k, a)]
forall k v. OMap k v -> [(k, v)]
OM.assocs

fromMapOM :: Ord k => Map k a -> OMap k a
fromMapOM :: forall k a. Ord k => Map k a -> OMap k a
fromMapOM = [(k, a)] -> OMap k a
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList ([(k, a)] -> OMap k a)
-> (Map k a -> [(k, a)]) -> Map k a -> OMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList

-- ----------------------------------------------------------------------------
-- 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 a = SISingle (ScenarioWith a) | SICollection Text (ScenarioCollection a)
  deriving ((forall a b. (a -> b) -> ScenarioItem a -> ScenarioItem b)
-> (forall a b. a -> ScenarioItem b -> ScenarioItem a)
-> Functor ScenarioItem
forall a b. a -> ScenarioItem b -> ScenarioItem a
forall a b. (a -> b) -> ScenarioItem a -> ScenarioItem b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ScenarioItem a -> ScenarioItem b
fmap :: forall a b. (a -> b) -> ScenarioItem a -> ScenarioItem b
$c<$ :: forall a b. a -> ScenarioItem b -> ScenarioItem a
<$ :: forall a b. a -> ScenarioItem b -> ScenarioItem a
Functor)

-- | Retrieve the name of a scenario item.
scenarioItemName :: ScenarioItem a -> Text
scenarioItemName :: forall a. ScenarioItem a -> Text
scenarioItemName (SISingle (ScenarioWith Scenario
s a
_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 a
_) = 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'.
newtype ScenarioCollection a = SC
  { forall a. ScenarioCollection a -> OMap FilePath (ScenarioItem a)
scMap :: OMap FilePath (ScenarioItem a)
  }
  deriving ((forall a b.
 (a -> b) -> ScenarioCollection a -> ScenarioCollection b)
-> (forall a b. a -> ScenarioCollection b -> ScenarioCollection a)
-> Functor ScenarioCollection
forall a b. a -> ScenarioCollection b -> ScenarioCollection a
forall a b.
(a -> b) -> ScenarioCollection a -> ScenarioCollection b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ScenarioCollection a -> ScenarioCollection b
fmap :: forall a b.
(a -> b) -> ScenarioCollection a -> ScenarioCollection b
$c<$ :: forall a b. a -> ScenarioCollection b -> ScenarioCollection a
<$ :: forall a b. a -> ScenarioCollection b -> ScenarioCollection a
Functor)

pathifyCollection :: Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection :: forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection = (ScenarioInfo -> ScenarioPath) -> f ScenarioInfo -> f ScenarioPath
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> ScenarioPath
ScenarioPath (FilePath -> ScenarioPath)
-> (ScenarioInfo -> FilePath) -> ScenarioInfo -> ScenarioPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting FilePath ScenarioInfo FilePath -> ScenarioInfo -> FilePath
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting FilePath ScenarioInfo FilePath
Lens' ScenarioInfo FilePath
scenarioPath)

-- | Access and modify 'ScenarioItem's in collection based on their path.
scenarioItemByPath :: FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath :: forall a.
FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath FilePath
path = [FilePath]
-> (ScenarioItem a -> f (ScenarioItem a))
-> ScenarioCollection a
-> f (ScenarioCollection a)
forall (f :: * -> *) a.
Applicative f =>
[FilePath]
-> (ScenarioItem a -> f (ScenarioItem a))
-> ScenarioCollection a
-> f (ScenarioCollection a)
ixp [FilePath]
ps
 where
  ps :: [FilePath]
ps = FilePath -> [FilePath]
splitDirectories FilePath
path
  ixp :: (Applicative f) => [String] -> (ScenarioItem a -> f (ScenarioItem a)) -> ScenarioCollection a -> f (ScenarioCollection a)
  ixp :: forall (f :: * -> *) a.
Applicative f =>
[FilePath]
-> (ScenarioItem a -> f (ScenarioItem a))
-> ScenarioCollection a
-> f (ScenarioCollection a)
ixp [] ScenarioItem a -> f (ScenarioItem a)
_ ScenarioCollection a
col = ScenarioCollection a -> f (ScenarioCollection a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScenarioCollection a
col
  ixp [FilePath
s] ScenarioItem a -> f (ScenarioItem a)
f (SC OMap FilePath (ScenarioItem a)
m) = OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC (OMap FilePath (ScenarioItem a) -> ScenarioCollection a)
-> f (OMap FilePath (ScenarioItem a)) -> f (ScenarioCollection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (OMap FilePath (ScenarioItem a))
-> Traversal'
     (OMap FilePath (ScenarioItem a))
     (IxValue (OMap FilePath (ScenarioItem a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
Index (OMap FilePath (ScenarioItem a))
s IxValue (OMap FilePath (ScenarioItem a))
-> f (IxValue (OMap FilePath (ScenarioItem a)))
ScenarioItem a -> f (ScenarioItem a)
f OMap FilePath (ScenarioItem a)
m
  ixp (FilePath
d : [FilePath]
xs) ScenarioItem a -> f (ScenarioItem a)
f (SC OMap FilePath (ScenarioItem a)
m) = OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC (OMap FilePath (ScenarioItem a) -> ScenarioCollection a)
-> f (OMap FilePath (ScenarioItem a)) -> f (ScenarioCollection a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Index (OMap FilePath (ScenarioItem a))
-> Traversal'
     (OMap FilePath (ScenarioItem a))
     (IxValue (OMap FilePath (ScenarioItem a)))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix FilePath
Index (OMap FilePath (ScenarioItem a))
d IxValue (OMap FilePath (ScenarioItem a))
-> f (IxValue (OMap FilePath (ScenarioItem a)))
ScenarioItem a -> f (ScenarioItem a)
inner OMap FilePath (ScenarioItem a)
m
   where
    inner :: ScenarioItem a -> f (ScenarioItem a)
inner ScenarioItem a
si = case ScenarioItem a
si of
      SISingle {} -> ScenarioItem a -> f (ScenarioItem a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScenarioItem a
si
      SICollection Text
n' ScenarioCollection a
col -> Text -> ScenarioCollection a -> ScenarioItem a
forall a. Text -> ScenarioCollection a -> ScenarioItem a
SICollection Text
n' (ScenarioCollection a -> ScenarioItem a)
-> f (ScenarioCollection a) -> f (ScenarioItem a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
-> (ScenarioItem a -> f (ScenarioItem a))
-> ScenarioCollection a
-> f (ScenarioCollection a)
forall (f :: * -> *) a.
Applicative f =>
[FilePath]
-> (ScenarioItem a -> f (ScenarioItem a))
-> ScenarioCollection a
-> f (ScenarioCollection a)
ixp [FilePath]
xs ScenarioItem a -> f (ScenarioItem a)
f ScenarioCollection a
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 a -> ScenarioCollection a
getTutorials :: forall a. ScenarioCollection a -> ScenarioCollection a
getTutorials ScenarioCollection a
sc = case FilePath
-> OMap FilePath (ScenarioItem a) -> Maybe (ScenarioItem a)
forall k v. Ord k => k -> OMap k v -> Maybe v
OM.lookup FilePath
tutorialsDirname (ScenarioCollection a -> OMap FilePath (ScenarioItem a)
forall a. ScenarioCollection a -> OMap FilePath (ScenarioItem a)
scMap ScenarioCollection a
sc) of
  Just (SICollection Text
_ ScenarioCollection a
c) -> ScenarioCollection a
c
  Maybe (ScenarioItem a)
_ -> OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC OMap FilePath (ScenarioItem a)
forall k v. OMap k v
OM.empty

-- | Canonicalize a scenario path, making it usable as a unique key.
normalizeScenarioPath ::
  (MonadIO m) =>
  ScenarioCollection a ->
  FilePath ->
  m FilePath
normalizeScenarioPath :: forall (m :: * -> *) a.
MonadIO m =>
ScenarioCollection a -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection a
col FilePath
p =
  let path :: FilePath
path = FilePath
p FilePath -> FilePath -> FilePath
-<.> FilePath
"yaml"
   in if Maybe (ScenarioItem a) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ScenarioItem a) -> Bool) -> Maybe (ScenarioItem a) -> Bool
forall a b. (a -> b) -> a -> b
$ ScenarioCollection a
col ScenarioCollection a
-> Getting
     (First (ScenarioItem a)) (ScenarioCollection a) (ScenarioItem a)
-> Maybe (ScenarioItem a)
forall s a. s -> Getting (First a) s a -> Maybe a
^? FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
forall a.
FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
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
eitherDataDir <- 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. Partial => Either l r -> r
fromRight' Either SystemFailure FilePath
eitherDataDir
          let n :: FilePath
n =
                FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"scenarios") FilePath
canonPath
                  Maybe FilePath -> (Maybe FilePath -> FilePath) -> FilePath
forall a b. a -> (a -> b) -> b
& FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
canonPath ((Char -> Bool) -> FilePath -> FilePath
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 a -> [ScenarioItem a]
scenarioCollectionToList :: forall a. ScenarioCollection a -> [ScenarioItem a]
scenarioCollectionToList (SC OMap FilePath (ScenarioItem a)
xs) = OMap FilePath (ScenarioItem a) -> [ScenarioItem a]
forall k a. OMap k a -> [a]
orderedElems OMap FilePath (ScenarioItem a)
xs

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

-- | Load all the scenarios from the scenarios data directory.
loadScenarios ::
  (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
  ScenarioInputs ->
  Bool ->
  m (ScenarioCollection ScenarioInfo)
loadScenarios :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> Bool -> m (ScenarioCollection ScenarioInfo)
loadScenarios ScenarioInputs
scenarioInputs Bool
loadTestScenarios = 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 ScenarioInfo
-> m (ScenarioCollection ScenarioInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioCollection ScenarioInfo
 -> m (ScenarioCollection ScenarioInfo))
-> ScenarioCollection ScenarioInfo
-> m (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ OMap FilePath (ScenarioItem ScenarioInfo)
-> ScenarioCollection ScenarioInfo
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC OMap FilePath (ScenarioItem ScenarioInfo)
forall k v. OMap k v
OM.empty
    Right FilePath
dataDir -> ScenarioInputs
-> Bool -> FilePath -> m (ScenarioCollection ScenarioInfo)
forall (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs
-> Bool -> FilePath -> m (ScenarioCollection ScenarioInfo)
loadScenarioDir ScenarioInputs
scenarioInputs Bool
loadTestScenarios 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"

testingDirectory :: FilePath
testingDirectory :: FilePath
testingDirectory = FilePath
"Testing"

readOrderFile :: FilePath -> IO (Maybe [String])
readOrderFile :: FilePath -> IO (Maybe [FilePath])
readOrderFile FilePath
orderFile = (FilePath -> [FilePath]) -> Maybe FilePath -> Maybe [FilePath]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
nonEmptyLines (Maybe FilePath -> Maybe [FilePath])
-> IO (Maybe FilePath) -> IO (Maybe [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
readFileMaybe FilePath
orderFile
 where
  nonEmptyLines :: String -> [String]
  nonEmptyLines :: FilePath -> [FilePath]
nonEmptyLines = (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
  readFileMaybe :: FilePath -> IO (Maybe String)
  readFileMaybe :: FilePath -> IO (Maybe FilePath)
readFileMaybe FilePath
path = (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile' FilePath
path) IO (Maybe FilePath)
-> (IOError -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
_ -> Maybe FilePath -> IO (Maybe FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing)

loadScenarioDir ::
  forall m sig.
  (Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
  ScenarioInputs ->
  Bool ->
  FilePath ->
  m (ScenarioCollection ScenarioInfo)
loadScenarioDir :: forall (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs
-> Bool -> FilePath -> m (ScenarioCollection ScenarioInfo)
loadScenarioDir ScenarioInputs
scenarioInputs Bool
loadTestScenarios FilePath
dir = do
  [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 -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> IO Bool
isYamlOrPublicDirectory 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
  Map FilePath (ScenarioItem ScenarioInfo)
scenarioMap <- [FilePath] -> m (Map FilePath (ScenarioItem ScenarioInfo))
loadItems [FilePath]
itemPaths
  IO (Maybe [FilePath]) -> m (Maybe [FilePath])
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (FilePath -> IO (Maybe [FilePath])
readOrderFile FilePath
orderFile) m (Maybe [FilePath])
-> (Maybe [FilePath] -> m (ScenarioCollection ScenarioInfo))
-> m (ScenarioCollection ScenarioInfo)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe [FilePath]
Nothing -> Map FilePath (ScenarioItem ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall a. Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
loadUnorderedScenarioDir Map FilePath (ScenarioItem ScenarioInfo)
scenarioMap
    Just [FilePath]
order -> [FilePath]
-> Map FilePath (ScenarioItem ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall a.
[FilePath]
-> Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
loadOrderedScenarioDir [FilePath]
order Map FilePath (ScenarioItem ScenarioInfo)
scenarioMap
 where
  dirName, orderFile, orderFileShortPath :: FilePath
  dirName :: FilePath
dirName = FilePath -> FilePath
takeBaseName FilePath
dir
  orderFile :: FilePath
orderFile = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
orderFileName
  orderFileShortPath :: FilePath
orderFileShortPath = FilePath
dirName FilePath -> FilePath -> FilePath
</> FilePath
orderFileName

  -- The function for individual directory items either warns about SystemFailure,
  -- or has thrown SystemFailure. The following code just adds that thrown failure to others.
  loadItems :: [FilePath] -> m (Map FilePath (ScenarioItem ScenarioInfo))
  loadItems :: [FilePath] -> m (Map FilePath (ScenarioItem ScenarioInfo))
loadItems [FilePath]
items = do
    let loadItem :: FilePath
-> m (Either SystemFailure (FilePath, ScenarioItem ScenarioInfo))
loadItem FilePath
f = forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow @SystemFailure (ThrowC SystemFailure m (FilePath, ScenarioItem ScenarioInfo)
 -> m (Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)))
-> ThrowC SystemFailure m (FilePath, ScenarioItem ScenarioInfo)
-> m (Either SystemFailure (FilePath, ScenarioItem ScenarioInfo))
forall a b. (a -> b) -> a -> b
$ (FilePath
f,) (ScenarioItem ScenarioInfo
 -> (FilePath, ScenarioItem ScenarioInfo))
-> ThrowC SystemFailure m (ScenarioItem ScenarioInfo)
-> ThrowC SystemFailure m (FilePath, ScenarioItem ScenarioInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScenarioInputs
-> Bool
-> FilePath
-> ThrowC SystemFailure m (ScenarioItem ScenarioInfo)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> Bool -> FilePath -> m (ScenarioItem ScenarioInfo)
loadScenarioItem ScenarioInputs
scenarioInputs Bool
loadTestScenarios (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
f)
    ([SystemFailure]
scenarioFailures, [(FilePath, ScenarioItem ScenarioInfo)]
okScenarios) <- [Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)]
-> ([SystemFailure], [(FilePath, ScenarioItem ScenarioInfo)])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)]
 -> ([SystemFailure], [(FilePath, ScenarioItem ScenarioInfo)]))
-> m [Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)]
-> m ([SystemFailure], [(FilePath, ScenarioItem ScenarioInfo)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath
 -> m (Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)))
-> [FilePath]
-> m [Either SystemFailure (FilePath, ScenarioItem ScenarioInfo)]
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 FilePath
-> m (Either SystemFailure (FilePath, ScenarioItem ScenarioInfo))
loadItem [FilePath]
items
    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]
scenarioFailures)
    Map FilePath (ScenarioItem ScenarioInfo)
-> m (Map FilePath (ScenarioItem ScenarioInfo))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map FilePath (ScenarioItem ScenarioInfo)
 -> m (Map FilePath (ScenarioItem ScenarioInfo)))
-> Map FilePath (ScenarioItem ScenarioInfo)
-> m (Map FilePath (ScenarioItem ScenarioInfo))
forall a b. (a -> b) -> a -> b
$ [(FilePath, ScenarioItem ScenarioInfo)]
-> Map FilePath (ScenarioItem ScenarioInfo)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(FilePath, ScenarioItem ScenarioInfo)]
okScenarios

  isHiddenDir :: String -> Bool
  isHiddenDir :: FilePath -> Bool
isHiddenDir FilePath
f = Bool -> Bool
not Bool
loadTestScenarios Bool -> Bool -> Bool
&& FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
testingDirectory

  -- Keep only files which are .yaml files or directories not starting with an underscore.
  -- Marked directories contain scenarios that can't be parsed (failure tests) or only script solutions.
  isYamlOrPublicDirectory :: FilePath -> String -> IO Bool
  isYamlOrPublicDirectory :: FilePath -> FilePath -> IO Bool
isYamlOrPublicDirectory 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 -> FilePath -> FilePath
</> 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 (FilePath
"_" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f Bool -> Bool -> Bool
|| FilePath -> Bool
isHiddenDir FilePath
f)
        else FilePath -> FilePath
takeExtensions FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
".yaml"

  -- warn that the ORDER file is missing
  loadUnorderedScenarioDir :: Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
  loadUnorderedScenarioDir :: forall a. Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
loadUnorderedScenarioDir Map FilePath (ScenarioItem a)
scenarioMap = 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
testingDirectory) (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
orderFileShortPath OrderFileWarning
NoOrderFile)
    ScenarioCollection a -> m (ScenarioCollection a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScenarioCollection a -> m (ScenarioCollection a))
-> (OMap FilePath (ScenarioItem a) -> ScenarioCollection a)
-> OMap FilePath (ScenarioItem a)
-> m (ScenarioCollection a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC (OMap FilePath (ScenarioItem a) -> m (ScenarioCollection a))
-> OMap FilePath (ScenarioItem a) -> m (ScenarioCollection a)
forall a b. (a -> b) -> a -> b
$ Map FilePath (ScenarioItem a) -> OMap FilePath (ScenarioItem a)
forall k a. Ord k => Map k a -> OMap k a
fromMapOM Map FilePath (ScenarioItem a)
scenarioMap

  -- warn if the ORDER file does not match directory contents
  loadOrderedScenarioDir :: [String] -> Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
  loadOrderedScenarioDir :: forall a.
[FilePath]
-> Map FilePath (ScenarioItem a) -> m (ScenarioCollection a)
loadOrderedScenarioDir [FilePath]
order Map FilePath (ScenarioItem a)
scenarioMap = do
    let missing :: [FilePath]
missing = Map FilePath (ScenarioItem a) -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath (ScenarioItem a)
scenarioMap [FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath]
order
        ([FilePath]
notPresent, [(FilePath, ScenarioItem a)]
loaded) = Map FilePath (ScenarioItem a)
-> [FilePath] -> ([FilePath], [(FilePath, ScenarioItem a)])
forall k v. Ord k => Map k v -> [k] -> ([k], [(k, v)])
lookupInOrder Map FilePath (ScenarioItem a)
scenarioMap [FilePath]
order
        dangling :: [FilePath]
dangling = (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
isHiddenDir) [FilePath]
notPresent

    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) (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
orderFileShortPath (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) (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
orderFileShortPath (OrderFileWarning -> SystemFailure)
-> (NonEmpty FilePath -> OrderFileWarning)
-> NonEmpty FilePath
-> SystemFailure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty FilePath -> OrderFileWarning
DanglingFiles)

    ScenarioCollection a -> m (ScenarioCollection a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScenarioCollection a -> m (ScenarioCollection a))
-> ScenarioCollection a -> m (ScenarioCollection a)
forall a b. (a -> b) -> a -> b
$ OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC (OMap FilePath (ScenarioItem a) -> ScenarioCollection a)
-> OMap FilePath (ScenarioItem a) -> ScenarioCollection a
forall a b. (a -> b) -> a -> b
$ [(FilePath, ScenarioItem a)] -> OMap FilePath (ScenarioItem a)
forall k v. Ord k => [(k, v)] -> OMap k v
OM.fromList [(FilePath, ScenarioItem a)]
loaded

-- | How to transform scenario path to save path.
scenarioPathToSavePath :: FilePath -> FilePath -> FilePath
scenarioPathToSavePath :: FilePath -> FilePath -> FilePath
scenarioPathToSavePath FilePath
path FilePath
swarmData = FilePath
swarmData FilePath -> FilePath -> FilePath
</> 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 Any -> FilePath -> IO FilePath
forall (m :: * -> *) a.
MonadIO m =>
ScenarioCollection a -> FilePath -> m FilePath
normalizeScenarioPath (OMap FilePath (ScenarioItem Any) -> ScenarioCollection Any
forall a. OMap FilePath (ScenarioItem a) -> ScenarioCollection a
SC OMap FilePath (ScenarioItem Any)
forall k v. OMap k v
OM.empty) 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 -> FilePath -> FilePath
scenarioPathToSavePath FilePath
path (FilePath -> FilePath) -> 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
forall a. a -> ScenarioStatus -> ScenarioInfoT a
ScenarioInfo FilePath
path ScenarioStatus
NotStarted
    else do
      ScenarioInfoT ()
si <-
        (ParseException -> SystemFailure)
-> ThrowC ParseException m (ScenarioInfoT ())
-> m (ScenarioInfoT ())
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 (ScenarioInfoT ())
 -> m (ScenarioInfoT ()))
-> (IO (Either ParseException (ScenarioInfoT ()))
    -> ThrowC ParseException m (ScenarioInfoT ()))
-> IO (Either ParseException (ScenarioInfoT ()))
-> m (ScenarioInfoT ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either ParseException (ScenarioInfoT ())
-> ThrowC ParseException m (ScenarioInfoT ())
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
Either e a -> m a
liftEither (Either ParseException (ScenarioInfoT ())
 -> ThrowC ParseException m (ScenarioInfoT ()))
-> (IO (Either ParseException (ScenarioInfoT ()))
    -> ThrowC
         ParseException m (Either ParseException (ScenarioInfoT ())))
-> IO (Either ParseException (ScenarioInfoT ()))
-> ThrowC ParseException m (ScenarioInfoT ())
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< IO (Either ParseException (ScenarioInfoT ()))
-> ThrowC
     ParseException m (Either ParseException (ScenarioInfoT ()))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO)
          (IO (Either ParseException (ScenarioInfoT ()))
 -> m (ScenarioInfoT ()))
-> IO (Either ParseException (ScenarioInfoT ()))
-> m (ScenarioInfoT ())
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either ParseException (ScenarioInfoT ()))
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
decodeFileEither FilePath
infoPath
      -- We overwrite the (void) path that was saved inside the yaml file, so that there
      -- is only a single authoritative path "key": the original scenario path.
      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
path FilePath -> ScenarioInfoT () -> ScenarioInfo
forall a b. a -> ScenarioInfoT b -> ScenarioInfoT a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (ScenarioInfoT ()
si :: ScenarioInfoT ())

-- | 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 -> FilePath -> FilePath
scenarioPathToSavePath FilePath
path (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO FilePath
getSwarmSavePath Bool
True
  -- We do not store the path in the save file (see #2390).
  FilePath -> ScenarioInfoT () -> IO ()
forall a. ToJSON a => FilePath -> a -> IO ()
encodeFile FilePath
infoPath (ScenarioInfoT () -> IO ()) -> ScenarioInfoT () -> IO ()
forall a b. (a -> b) -> a -> b
$ ScenarioInfo -> ScenarioInfoT ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 ->
  Bool ->
  FilePath ->
  m (ScenarioItem ScenarioInfo)
loadScenarioItem :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> Bool -> FilePath -> m (ScenarioItem ScenarioInfo)
loadScenarioItem ScenarioInputs
scenarioInputs Bool
loadTestScenarios 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) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeBaseName (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
path
  case Bool
isDir of
    Bool
True -> Text
-> ScenarioCollection ScenarioInfo -> ScenarioItem ScenarioInfo
forall a. Text -> ScenarioCollection a -> ScenarioItem a
SICollection Text
collectionName (ScenarioCollection ScenarioInfo -> ScenarioItem ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
-> m (ScenarioItem ScenarioInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScenarioInputs
-> Bool -> FilePath -> m (ScenarioCollection ScenarioInfo)
forall (m :: * -> *) (sig :: (* -> *) -> * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs
-> Bool -> FilePath -> m (ScenarioCollection ScenarioInfo)
loadScenarioDir ScenarioInputs
scenarioInputs Bool
loadTestScenarios 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 ScenarioInfo -> m (ScenarioItem ScenarioInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioItem ScenarioInfo -> m (ScenarioItem ScenarioInfo))
-> ScenarioItem ScenarioInfo -> m (ScenarioItem ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ ScenarioWith ScenarioInfo -> ScenarioItem ScenarioInfo
forall a. ScenarioWith a -> ScenarioItem a
SISingle (ScenarioWith ScenarioInfo -> ScenarioItem ScenarioInfo)
-> ScenarioWith ScenarioInfo -> ScenarioItem ScenarioInfo
forall a b. (a -> b) -> a -> b
$ Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith 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 ScenarioInfo -> m (ScenarioItem ScenarioInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ScenarioItem ScenarioInfo -> m (ScenarioItem ScenarioInfo))
-> (ScenarioInfo -> ScenarioItem ScenarioInfo)
-> ScenarioInfo
-> m (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioWith ScenarioInfo -> ScenarioItem ScenarioInfo
forall a. ScenarioWith a -> ScenarioItem a
SISingle (ScenarioWith ScenarioInfo -> ScenarioItem ScenarioInfo)
-> (ScenarioInfo -> ScenarioWith ScenarioInfo)
-> ScenarioInfo
-> ScenarioItem ScenarioInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
s (ScenarioInfo -> m (ScenarioItem ScenarioInfo))
-> ScenarioInfo -> m (ScenarioItem ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ FilePath -> ScenarioStatus -> ScenarioInfo
forall a. a -> ScenarioStatus -> ScenarioInfoT a
ScenarioInfo FilePath
path ScenarioStatus
NotStarted

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

makePrisms ''ScenarioItem
makePrisms ''ScenarioStatus