{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

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

-- |
-- Module      :  Swarm.Game.ScenarioStatus
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- 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,
  _InProgress,
  _Complete,
  ScenarioInfo (..),
  scenarioPath,
  scenarioStatus,
  scenarioBestTime,
  scenarioBestTicks,
  updateScenarioInfoOnQuit,
  ScenarioInfoPair,

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

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

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

import Control.Algebra (Has)
import Control.Carrier.Lift (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)

-- Some orphan ZonedTime instances

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

-- | A @ScenarioStatus@ stores the status of a scenario along with
--   appropriate metadata: not started, in progress, or complete.
--   Note that "in progress" is currently a bit of a misnomer since
--   games cannot be saved; at the moment it really means more like
--   "you played this scenario before but didn't win".
data ScenarioStatus
  = NotStarted
  | InProgress
      { -- | Time when the scenario was started including time zone.
        ScenarioStatus -> ZonedTime
_scenarioStarted :: ZonedTime
      , -- | Time elapsed until quitting the scenario.
        ScenarioStatus -> NominalDiffTime
_scenarioElapsed :: NominalDiffTime
      , -- | Ticks elapsed until quitting the scenario.
        ScenarioStatus -> Integer
_scenarioElapsedTicks :: Integer
      }
  | Complete
      { -- | Time when the scenario was started including time zone.
        _scenarioStarted :: ZonedTime
      , -- | Time elapsed until quitting the scenario.
        _scenarioElapsed :: NominalDiffTime
      , -- | Ticks elapsed until quitting the scenario.
        _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

-- | A @ScenarioInfo@ record stores metadata about a scenario: its
--   canonical path, most recent status, and best-ever status.
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

-- | The path of the scenario, relative to @data/scenarios@.
scenarioPath :: Lens' ScenarioInfo FilePath

-- | The status of the scenario.
scenarioStatus :: Lens' ScenarioInfo ScenarioStatus

-- | The best status of the scenario, measured in real world time.
scenarioBestTime :: Lens' ScenarioInfo ScenarioStatus

-- | The best status of the scenario, measured in game ticks.
scenarioBestTicks :: Lens' ScenarioInfo ScenarioStatus

-- | Update the current @ScenarioInfo@ record when quitting a game.
--
-- Note that when comparing "best" times, shorter is not always better!
-- As long as the scenario is not completed (e.g. some do not have win condition)
-- we consider having fun _longer_ to be better.
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 -- keep faster completed
          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 -- keep longer progress (fun!)
          ScenarioStatus
_ -> ScenarioStatus
cur -- otherwise update with current
     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!"

-- ----------------------------------------------------------------------------
-- 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 (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)

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

-- | A scenario collection is a tree of scenarios, keyed by name,
--   together with an optional order.  Invariant: every item in the
--   scOrder exists as a key in the scMap.
data ScenarioCollection = SC
  { ScenarioCollection -> Maybe [FilePath]
scOrder :: Maybe [FilePath]
  , ScenarioCollection -> Map FilePath ScenarioItem
scMap :: Map FilePath ScenarioItem
  }
  deriving (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)

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

-- | Canonicalize a scenario path, making it usable as a unique key.
normalizeScenarioPath :: 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
"." -- no way we got this far without data directory
          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

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

-- | Load all the scenarios from the scenarios data directory.
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

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

-- | 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 (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 ()

  -- Only keep the files from 00-ORDER.txt that actually exist.
  let morder' :: Maybe [FilePath]
morder' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
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"])

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

-- | Load saved info about played scenario from XDG data directory.
loadScenarioInfo ::
  (Has (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

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

-- | Load a scenario item (either a scenario, or a subdirectory
--   containing a collection of scenarios) from a particular path.
loadScenarioItem ::
  (Has (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)

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

makePrisms ''ScenarioItem
makePrisms ''ScenarioStatus