{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- High-level status of scenario play.
-- Representation of progress, logic for updating.
module Swarm.Game.Scenario.Status where

import Control.Lens hiding (from, (<.>))
import Data.Aeson (
  genericParseJSON,
  genericToEncoding,
  genericToJSON,
 )
import Data.Function (on)
import Data.Time (ZonedTime, diffUTCTime, zonedTimeToUTC)
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Scoring.Best
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Scoring.ConcreteMetrics
import Swarm.Game.Scenario.Scoring.GenericMetrics
import Swarm.Game.Tick (TickNumber)
import Swarm.Game.World.Gen (Seed)
import Swarm.Util.Lens (makeLensesNoSigs)

-- | These launch parameters are used in a number of ways:
--
-- * Serializing the seed/script path for saves
-- * Holding parse status from form fields, including error info
-- * Carrying fully-validated launch parameters.
--
-- Type parameters are utilized to support all of these use cases.
data ParameterizableLaunchParams code f = LaunchParams
  { forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe Seed)
seedVal :: f (Maybe Seed)
  , forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode :: f (Maybe code)
  }

type SerializableLaunchParams = ParameterizableLaunchParams FilePath Identity
deriving instance Eq SerializableLaunchParams
deriving instance Ord SerializableLaunchParams
deriving instance Show SerializableLaunchParams
deriving instance Read SerializableLaunchParams
deriving instance Generic SerializableLaunchParams
deriving instance FromJSON SerializableLaunchParams
deriving instance ToJSON SerializableLaunchParams

-- | A 'ScenarioStatus' stores the status of a scenario along with
--   appropriate metadata: 'NotStarted', or 'Played'.
--   The 'Played' status has two sub-states: 'Attempted' or 'Completed'.
data ScenarioStatus
  = NotStarted
  | Played
      SerializableLaunchParams
      ProgressMetric
      BestRecords
  deriving (ScenarioStatus -> ScenarioStatus -> Bool
(ScenarioStatus -> ScenarioStatus -> Bool)
-> (ScenarioStatus -> ScenarioStatus -> Bool) -> Eq ScenarioStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScenarioStatus -> ScenarioStatus -> Bool
== :: ScenarioStatus -> ScenarioStatus -> Bool
$c/= :: ScenarioStatus -> ScenarioStatus -> Bool
/= :: ScenarioStatus -> ScenarioStatus -> Bool
Eq, Eq ScenarioStatus
Eq ScenarioStatus =>
(ScenarioStatus -> ScenarioStatus -> Ordering)
-> (ScenarioStatus -> ScenarioStatus -> Bool)
-> (ScenarioStatus -> ScenarioStatus -> Bool)
-> (ScenarioStatus -> ScenarioStatus -> Bool)
-> (ScenarioStatus -> ScenarioStatus -> Bool)
-> (ScenarioStatus -> ScenarioStatus -> ScenarioStatus)
-> (ScenarioStatus -> ScenarioStatus -> ScenarioStatus)
-> Ord 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
$ccompare :: ScenarioStatus -> ScenarioStatus -> Ordering
compare :: ScenarioStatus -> ScenarioStatus -> Ordering
$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
>= :: ScenarioStatus -> ScenarioStatus -> Bool
$cmax :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
max :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
$cmin :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
min :: ScenarioStatus -> ScenarioStatus -> ScenarioStatus
Ord, Seed -> ScenarioStatus -> ShowS
[ScenarioStatus] -> ShowS
ScenarioStatus -> FilePath
(Seed -> ScenarioStatus -> ShowS)
-> (ScenarioStatus -> FilePath)
-> ([ScenarioStatus] -> ShowS)
-> Show ScenarioStatus
forall a.
(Seed -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Seed -> ScenarioStatus -> ShowS
showsPrec :: Seed -> ScenarioStatus -> ShowS
$cshow :: ScenarioStatus -> FilePath
show :: ScenarioStatus -> FilePath
$cshowList :: [ScenarioStatus] -> ShowS
showList :: [ScenarioStatus] -> ShowS
Show, ReadPrec [ScenarioStatus]
ReadPrec ScenarioStatus
Seed -> ReadS ScenarioStatus
ReadS [ScenarioStatus]
(Seed -> ReadS ScenarioStatus)
-> ReadS [ScenarioStatus]
-> ReadPrec ScenarioStatus
-> ReadPrec [ScenarioStatus]
-> Read ScenarioStatus
forall a.
(Seed -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Seed -> ReadS ScenarioStatus
readsPrec :: Seed -> ReadS ScenarioStatus
$creadList :: ReadS [ScenarioStatus]
readList :: ReadS [ScenarioStatus]
$creadPrec :: ReadPrec ScenarioStatus
readPrec :: ReadPrec ScenarioStatus
$creadListPrec :: ReadPrec [ScenarioStatus]
readListPrec :: ReadPrec [ScenarioStatus]
Read, (forall x. ScenarioStatus -> Rep ScenarioStatus x)
-> (forall x. Rep ScenarioStatus x -> ScenarioStatus)
-> Generic ScenarioStatus
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
$cfrom :: forall x. ScenarioStatus -> Rep ScenarioStatus x
from :: forall x. ScenarioStatus -> Rep ScenarioStatus x
$cto :: forall x. Rep ScenarioStatus x -> ScenarioStatus
to :: forall x. Rep ScenarioStatus x -> ScenarioStatus
Generic)

instance FromJSON ScenarioStatus where
  parseJSON :: Value -> Parser ScenarioStatus
parseJSON = Options -> Value -> Parser ScenarioStatus
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
scenarioOptions

instance ToJSON ScenarioStatus where
  toEncoding :: ScenarioStatus -> Encoding
toEncoding = Options -> ScenarioStatus -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
  toJSON :: ScenarioStatus -> Value
toJSON = Options -> ScenarioStatus -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
scenarioOptions

seedLaunchParams :: Applicative f => Maybe Seed -> ParameterizableLaunchParams a f
seedLaunchParams :: forall (f :: * -> *) a.
Applicative f =>
Maybe Seed -> ParameterizableLaunchParams a f
seedLaunchParams Maybe Seed
s = f (Maybe Seed) -> f (Maybe a) -> ParameterizableLaunchParams a f
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> f (Maybe Seed)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Seed
s) (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

emptyLaunchParams :: Applicative f => ParameterizableLaunchParams a f
emptyLaunchParams :: forall (f :: * -> *) a.
Applicative f =>
ParameterizableLaunchParams a f
emptyLaunchParams = f (Maybe Seed) -> f (Maybe a) -> ParameterizableLaunchParams a f
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> f (Maybe Seed)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Seed
forall a. Maybe a
Nothing) (Maybe a -> f (Maybe a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)

getLaunchParams :: ScenarioStatus -> SerializableLaunchParams
getLaunchParams :: ScenarioStatus -> SerializableLaunchParams
getLaunchParams = \case
  ScenarioStatus
NotStarted -> SerializableLaunchParams
forall (f :: * -> *) a.
Applicative f =>
ParameterizableLaunchParams a f
emptyLaunchParams
  Played SerializableLaunchParams
x ProgressMetric
_ BestRecords
_ -> SerializableLaunchParams
x

-- | A 'ScenarioInfo' record stores metadata about a scenario: its
-- canonical path and status.
-- By way of the 'ScenarioStatus' record, it stores the
-- most recent status and best-ever status.
data ScenarioInfo = ScenarioInfo
  { ScenarioInfo -> FilePath
_scenarioPath :: FilePath
  , ScenarioInfo -> ScenarioStatus
_scenarioStatus :: ScenarioStatus
  }
  deriving (ScenarioInfo -> ScenarioInfo -> Bool
(ScenarioInfo -> ScenarioInfo -> Bool)
-> (ScenarioInfo -> ScenarioInfo -> Bool) -> Eq ScenarioInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScenarioInfo -> ScenarioInfo -> Bool
== :: ScenarioInfo -> ScenarioInfo -> Bool
$c/= :: ScenarioInfo -> ScenarioInfo -> Bool
/= :: ScenarioInfo -> ScenarioInfo -> Bool
Eq, Eq ScenarioInfo
Eq ScenarioInfo =>
(ScenarioInfo -> ScenarioInfo -> Ordering)
-> (ScenarioInfo -> ScenarioInfo -> Bool)
-> (ScenarioInfo -> ScenarioInfo -> Bool)
-> (ScenarioInfo -> ScenarioInfo -> Bool)
-> (ScenarioInfo -> ScenarioInfo -> Bool)
-> (ScenarioInfo -> ScenarioInfo -> ScenarioInfo)
-> (ScenarioInfo -> ScenarioInfo -> ScenarioInfo)
-> Ord 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
$ccompare :: ScenarioInfo -> ScenarioInfo -> Ordering
compare :: ScenarioInfo -> ScenarioInfo -> Ordering
$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
>= :: ScenarioInfo -> ScenarioInfo -> Bool
$cmax :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
max :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
$cmin :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
min :: ScenarioInfo -> ScenarioInfo -> ScenarioInfo
Ord, Seed -> ScenarioInfo -> ShowS
[ScenarioInfo] -> ShowS
ScenarioInfo -> FilePath
(Seed -> ScenarioInfo -> ShowS)
-> (ScenarioInfo -> FilePath)
-> ([ScenarioInfo] -> ShowS)
-> Show ScenarioInfo
forall a.
(Seed -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Seed -> ScenarioInfo -> ShowS
showsPrec :: Seed -> ScenarioInfo -> ShowS
$cshow :: ScenarioInfo -> FilePath
show :: ScenarioInfo -> FilePath
$cshowList :: [ScenarioInfo] -> ShowS
showList :: [ScenarioInfo] -> ShowS
Show, ReadPrec [ScenarioInfo]
ReadPrec ScenarioInfo
Seed -> ReadS ScenarioInfo
ReadS [ScenarioInfo]
(Seed -> ReadS ScenarioInfo)
-> ReadS [ScenarioInfo]
-> ReadPrec ScenarioInfo
-> ReadPrec [ScenarioInfo]
-> Read ScenarioInfo
forall a.
(Seed -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Seed -> ReadS ScenarioInfo
readsPrec :: Seed -> ReadS ScenarioInfo
$creadList :: ReadS [ScenarioInfo]
readList :: ReadS [ScenarioInfo]
$creadPrec :: ReadPrec ScenarioInfo
readPrec :: ReadPrec ScenarioInfo
$creadListPrec :: ReadPrec [ScenarioInfo]
readListPrec :: ReadPrec [ScenarioInfo]
Read, (forall x. ScenarioInfo -> Rep ScenarioInfo x)
-> (forall x. Rep ScenarioInfo x -> ScenarioInfo)
-> Generic ScenarioInfo
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
$cfrom :: forall x. ScenarioInfo -> Rep ScenarioInfo x
from :: forall x. ScenarioInfo -> Rep ScenarioInfo x
$cto :: forall x. Rep ScenarioInfo x -> ScenarioInfo
to :: forall x. Rep ScenarioInfo x -> ScenarioInfo
Generic)

instance FromJSON ScenarioInfo where
  parseJSON :: Value -> Parser ScenarioInfo
parseJSON = Options -> Value -> Parser ScenarioInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
scenarioOptions

instance ToJSON ScenarioInfo where
  toEncoding :: ScenarioInfo -> Encoding
toEncoding = Options -> ScenarioInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
  toJSON :: ScenarioInfo -> Value
toJSON = Options -> ScenarioInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
scenarioOptions

type ScenarioInfoPair = (Scenario, ScenarioInfo)

makeLensesNoSigs ''ScenarioInfo

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

-- | The status of the scenario.
scenarioStatus :: 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.
updateScenarioInfoOnFinish ::
  CodeSizeDeterminators ->
  ZonedTime ->
  TickNumber ->
  Bool ->
  ScenarioInfo ->
  ScenarioInfo
updateScenarioInfoOnFinish :: CodeSizeDeterminators
-> ZonedTime -> TickNumber -> Bool -> ScenarioInfo -> ScenarioInfo
updateScenarioInfoOnFinish
  CodeSizeDeterminators
csd
  ZonedTime
z
  TickNumber
ticks
  Bool
completed
  si :: ScenarioInfo
si@(ScenarioInfo FilePath
p ScenarioStatus
prevPlayState) = case ScenarioStatus
prevPlayState of
    Played SerializableLaunchParams
launchParams (Metric Progress
_ (ProgressStats ZonedTime
start AttemptMetrics
_currentPlayMetrics)) BestRecords
prevBestRecords ->
      FilePath -> ScenarioStatus -> ScenarioInfo
ScenarioInfo FilePath
p (ScenarioStatus -> ScenarioInfo) -> ScenarioStatus -> ScenarioInfo
forall a b. (a -> b) -> a -> b
$
        SerializableLaunchParams
-> ProgressMetric -> BestRecords -> ScenarioStatus
Played SerializableLaunchParams
launchParams ProgressMetric
newPlayMetric (BestRecords -> ScenarioStatus) -> BestRecords -> ScenarioStatus
forall a b. (a -> b) -> a -> b
$
          ProgressMetric -> BestRecords -> BestRecords
updateBest ProgressMetric
newPlayMetric BestRecords
prevBestRecords
     where
      el :: NominalDiffTime
el = (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (UTCTime -> UTCTime -> NominalDiffTime)
-> (ZonedTime -> UTCTime)
-> ZonedTime
-> ZonedTime
-> NominalDiffTime
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC) ZonedTime
z ZonedTime
start
      cs :: Maybe ScenarioCodeMetrics
cs = CodeSizeDeterminators -> Maybe ScenarioCodeMetrics
codeSizeFromDeterminator CodeSizeDeterminators
csd
      newCompletionFlag :: Progress
newCompletionFlag = if Bool
completed then Progress
Completed else Progress
Attempted
      newPlayMetric :: ProgressMetric
newPlayMetric =
        Progress -> ProgressStats -> ProgressMetric
forall a. Progress -> a -> Metric a
Metric Progress
newCompletionFlag (ProgressStats -> ProgressMetric)
-> ProgressStats -> ProgressMetric
forall a b. (a -> b) -> a -> b
$
          ZonedTime -> AttemptMetrics -> ProgressStats
ProgressStats ZonedTime
start (AttemptMetrics -> ProgressStats)
-> AttemptMetrics -> ProgressStats
forall a b. (a -> b) -> a -> b
$
            DurationMetrics -> Maybe ScenarioCodeMetrics -> AttemptMetrics
AttemptMetrics (NominalDiffTime -> TickNumber -> DurationMetrics
DurationMetrics NominalDiffTime
el TickNumber
ticks) Maybe ScenarioCodeMetrics
cs
    ScenarioStatus
_ -> ScenarioInfo
si