{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
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)
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
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
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
scenarioPath :: Lens' ScenarioInfo FilePath
scenarioStatus :: Lens' ScenarioInfo ScenarioStatus
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