{-# 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.CESK (TickNumber)
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.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
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, Seed -> ScenarioStatus -> ShowS
[ScenarioStatus] -> ShowS
ScenarioStatus -> FilePath
forall a.
(Seed -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioStatus] -> ShowS
$cshowList :: [ScenarioStatus] -> ShowS
show :: ScenarioStatus -> FilePath
$cshow :: ScenarioStatus -> FilePath
showsPrec :: Seed -> ScenarioStatus -> ShowS
$cshowsPrec :: Seed -> ScenarioStatus -> ShowS
Show, ReadPrec [ScenarioStatus]
ReadPrec ScenarioStatus
Seed -> ReadS ScenarioStatus
ReadS [ScenarioStatus]
forall a.
(Seed -> 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 :: Seed -> ReadS ScenarioStatus
$creadsPrec :: Seed -> 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

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

getLaunchParams :: ScenarioStatus -> SerializableLaunchParams
getLaunchParams :: ScenarioStatus -> SerializableLaunchParams
getLaunchParams = \case
  ScenarioStatus
NotStarted -> 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
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, Seed -> ScenarioInfo -> ShowS
[ScenarioInfo] -> ShowS
ScenarioInfo -> FilePath
forall a.
(Seed -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ScenarioInfo] -> ShowS
$cshowList :: [ScenarioInfo] -> ShowS
show :: ScenarioInfo -> FilePath
$cshow :: ScenarioInfo -> FilePath
showsPrec :: Seed -> ScenarioInfo -> ShowS
$cshowsPrec :: Seed -> ScenarioInfo -> ShowS
Show, ReadPrec [ScenarioInfo]
ReadPrec ScenarioInfo
Seed -> ReadS ScenarioInfo
ReadS [ScenarioInfo]
forall a.
(Seed -> 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 :: Seed -> ReadS ScenarioInfo
$creadsPrec :: Seed -> 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)

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 forall a b. (a -> b) -> a -> b
$
        SerializableLaunchParams
-> ProgressMetric -> BestRecords -> ScenarioStatus
Played SerializableLaunchParams
launchParams ProgressMetric
newPlayMetric forall a b. (a -> b) -> a -> b
$
          ProgressMetric -> BestRecords -> BestRecords
updateBest ProgressMetric
newPlayMetric BestRecords
prevBestRecords
     where
      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
      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 =
        forall a. Progress -> a -> Metric a
Metric Progress
newCompletionFlag forall a b. (a -> b) -> a -> b
$
          ZonedTime -> AttemptMetrics -> ProgressStats
ProgressStats ZonedTime
start 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