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

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Types and records for updating and retrieving
-- the best scores for a scenario.
module Swarm.Game.Scenario.Scoring.Best where

import Control.Arrow ((&&&))
import Control.Lens hiding (from, (<.>))
import Data.Aeson (
  genericParseJSON,
  genericToEncoding,
  genericToJSON,
 )
import Data.Function (on)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Time (ZonedTime, zonedTimeToUTC)
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.Game.Scenario.Scoring.CodeSize
import Swarm.Game.Scenario.Scoring.ConcreteMetrics
import Swarm.Game.Scenario.Scoring.GenericMetrics
import Swarm.Util.Lens (makeLensesNoSigs)

-- * Some orphan ZonedTime instances

instance Eq ZonedTime where
  == :: ZonedTime -> ZonedTime -> Bool
(==) = UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
(==) (UTCTime -> UTCTime -> Bool)
-> (ZonedTime -> UTCTime) -> ZonedTime -> ZonedTime -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC

instance Ord ZonedTime where
  <= :: ZonedTime -> ZonedTime -> Bool
(<=) = UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
(<=) (UTCTime -> UTCTime -> Bool)
-> (ZonedTime -> UTCTime) -> ZonedTime -> ZonedTime -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC

-- * High scores by various criteria

data BestByCriteria
  = BestByTime
  | BestByTicks
  | BestByCharCount
  | BestByAstSize
  deriving (BestByCriteria -> BestByCriteria -> Bool
(BestByCriteria -> BestByCriteria -> Bool)
-> (BestByCriteria -> BestByCriteria -> Bool) -> Eq BestByCriteria
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BestByCriteria -> BestByCriteria -> Bool
== :: BestByCriteria -> BestByCriteria -> Bool
$c/= :: BestByCriteria -> BestByCriteria -> Bool
/= :: BestByCriteria -> BestByCriteria -> Bool
Eq, Eq BestByCriteria
Eq BestByCriteria =>
(BestByCriteria -> BestByCriteria -> Ordering)
-> (BestByCriteria -> BestByCriteria -> Bool)
-> (BestByCriteria -> BestByCriteria -> Bool)
-> (BestByCriteria -> BestByCriteria -> Bool)
-> (BestByCriteria -> BestByCriteria -> Bool)
-> (BestByCriteria -> BestByCriteria -> BestByCriteria)
-> (BestByCriteria -> BestByCriteria -> BestByCriteria)
-> Ord BestByCriteria
BestByCriteria -> BestByCriteria -> Bool
BestByCriteria -> BestByCriteria -> Ordering
BestByCriteria -> BestByCriteria -> BestByCriteria
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 :: BestByCriteria -> BestByCriteria -> Ordering
compare :: BestByCriteria -> BestByCriteria -> Ordering
$c< :: BestByCriteria -> BestByCriteria -> Bool
< :: BestByCriteria -> BestByCriteria -> Bool
$c<= :: BestByCriteria -> BestByCriteria -> Bool
<= :: BestByCriteria -> BestByCriteria -> Bool
$c> :: BestByCriteria -> BestByCriteria -> Bool
> :: BestByCriteria -> BestByCriteria -> Bool
$c>= :: BestByCriteria -> BestByCriteria -> Bool
>= :: BestByCriteria -> BestByCriteria -> Bool
$cmax :: BestByCriteria -> BestByCriteria -> BestByCriteria
max :: BestByCriteria -> BestByCriteria -> BestByCriteria
$cmin :: BestByCriteria -> BestByCriteria -> BestByCriteria
min :: BestByCriteria -> BestByCriteria -> BestByCriteria
Ord, BestByCriteria
BestByCriteria -> BestByCriteria -> Bounded BestByCriteria
forall a. a -> a -> Bounded a
$cminBound :: BestByCriteria
minBound :: BestByCriteria
$cmaxBound :: BestByCriteria
maxBound :: BestByCriteria
Bounded, Int -> BestByCriteria
BestByCriteria -> Int
BestByCriteria -> [BestByCriteria]
BestByCriteria -> BestByCriteria
BestByCriteria -> BestByCriteria -> [BestByCriteria]
BestByCriteria
-> BestByCriteria -> BestByCriteria -> [BestByCriteria]
(BestByCriteria -> BestByCriteria)
-> (BestByCriteria -> BestByCriteria)
-> (Int -> BestByCriteria)
-> (BestByCriteria -> Int)
-> (BestByCriteria -> [BestByCriteria])
-> (BestByCriteria -> BestByCriteria -> [BestByCriteria])
-> (BestByCriteria -> BestByCriteria -> [BestByCriteria])
-> (BestByCriteria
    -> BestByCriteria -> BestByCriteria -> [BestByCriteria])
-> Enum BestByCriteria
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: BestByCriteria -> BestByCriteria
succ :: BestByCriteria -> BestByCriteria
$cpred :: BestByCriteria -> BestByCriteria
pred :: BestByCriteria -> BestByCriteria
$ctoEnum :: Int -> BestByCriteria
toEnum :: Int -> BestByCriteria
$cfromEnum :: BestByCriteria -> Int
fromEnum :: BestByCriteria -> Int
$cenumFrom :: BestByCriteria -> [BestByCriteria]
enumFrom :: BestByCriteria -> [BestByCriteria]
$cenumFromThen :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFromThen :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
$cenumFromTo :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFromTo :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
$cenumFromThenTo :: BestByCriteria
-> BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFromThenTo :: BestByCriteria
-> BestByCriteria -> BestByCriteria -> [BestByCriteria]
Enum, Int -> BestByCriteria -> ShowS
[BestByCriteria] -> ShowS
BestByCriteria -> [Char]
(Int -> BestByCriteria -> ShowS)
-> (BestByCriteria -> [Char])
-> ([BestByCriteria] -> ShowS)
-> Show BestByCriteria
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BestByCriteria -> ShowS
showsPrec :: Int -> BestByCriteria -> ShowS
$cshow :: BestByCriteria -> [Char]
show :: BestByCriteria -> [Char]
$cshowList :: [BestByCriteria] -> ShowS
showList :: [BestByCriteria] -> ShowS
Show)

describeCriteria :: BestByCriteria -> Text
describeCriteria :: BestByCriteria -> Text
describeCriteria = \case
  BestByCriteria
BestByTime -> Text
"time"
  BestByCriteria
BestByTicks -> Text
"ticks"
  BestByCriteria
BestByCharCount -> Text
"char count"
  BestByCriteria
BestByAstSize -> Text
"AST size"

data ProgressStats = ProgressStats
  { ProgressStats -> ZonedTime
_scenarioStarted :: ZonedTime
  -- ^ Time when the scenario was started including time zone.
  , ProgressStats -> AttemptMetrics
_scenarioAttemptMetrics :: AttemptMetrics
  }
  deriving (ProgressStats -> ProgressStats -> Bool
(ProgressStats -> ProgressStats -> Bool)
-> (ProgressStats -> ProgressStats -> Bool) -> Eq ProgressStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProgressStats -> ProgressStats -> Bool
== :: ProgressStats -> ProgressStats -> Bool
$c/= :: ProgressStats -> ProgressStats -> Bool
/= :: ProgressStats -> ProgressStats -> Bool
Eq, Eq ProgressStats
Eq ProgressStats =>
(ProgressStats -> ProgressStats -> Ordering)
-> (ProgressStats -> ProgressStats -> Bool)
-> (ProgressStats -> ProgressStats -> Bool)
-> (ProgressStats -> ProgressStats -> Bool)
-> (ProgressStats -> ProgressStats -> Bool)
-> (ProgressStats -> ProgressStats -> ProgressStats)
-> (ProgressStats -> ProgressStats -> ProgressStats)
-> Ord ProgressStats
ProgressStats -> ProgressStats -> Bool
ProgressStats -> ProgressStats -> Ordering
ProgressStats -> ProgressStats -> ProgressStats
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 :: ProgressStats -> ProgressStats -> Ordering
compare :: ProgressStats -> ProgressStats -> Ordering
$c< :: ProgressStats -> ProgressStats -> Bool
< :: ProgressStats -> ProgressStats -> Bool
$c<= :: ProgressStats -> ProgressStats -> Bool
<= :: ProgressStats -> ProgressStats -> Bool
$c> :: ProgressStats -> ProgressStats -> Bool
> :: ProgressStats -> ProgressStats -> Bool
$c>= :: ProgressStats -> ProgressStats -> Bool
>= :: ProgressStats -> ProgressStats -> Bool
$cmax :: ProgressStats -> ProgressStats -> ProgressStats
max :: ProgressStats -> ProgressStats -> ProgressStats
$cmin :: ProgressStats -> ProgressStats -> ProgressStats
min :: ProgressStats -> ProgressStats -> ProgressStats
Ord, Int -> ProgressStats -> ShowS
[ProgressStats] -> ShowS
ProgressStats -> [Char]
(Int -> ProgressStats -> ShowS)
-> (ProgressStats -> [Char])
-> ([ProgressStats] -> ShowS)
-> Show ProgressStats
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProgressStats -> ShowS
showsPrec :: Int -> ProgressStats -> ShowS
$cshow :: ProgressStats -> [Char]
show :: ProgressStats -> [Char]
$cshowList :: [ProgressStats] -> ShowS
showList :: [ProgressStats] -> ShowS
Show, ReadPrec [ProgressStats]
ReadPrec ProgressStats
Int -> ReadS ProgressStats
ReadS [ProgressStats]
(Int -> ReadS ProgressStats)
-> ReadS [ProgressStats]
-> ReadPrec ProgressStats
-> ReadPrec [ProgressStats]
-> Read ProgressStats
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ProgressStats
readsPrec :: Int -> ReadS ProgressStats
$creadList :: ReadS [ProgressStats]
readList :: ReadS [ProgressStats]
$creadPrec :: ReadPrec ProgressStats
readPrec :: ReadPrec ProgressStats
$creadListPrec :: ReadPrec [ProgressStats]
readListPrec :: ReadPrec [ProgressStats]
Read, (forall x. ProgressStats -> Rep ProgressStats x)
-> (forall x. Rep ProgressStats x -> ProgressStats)
-> Generic ProgressStats
forall x. Rep ProgressStats x -> ProgressStats
forall x. ProgressStats -> Rep ProgressStats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ProgressStats -> Rep ProgressStats x
from :: forall x. ProgressStats -> Rep ProgressStats x
$cto :: forall x. Rep ProgressStats x -> ProgressStats
to :: forall x. Rep ProgressStats x -> ProgressStats
Generic)

makeLenses ''ProgressStats

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

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

type ProgressMetric = Metric ProgressStats

-- * High scores by various criteria

data BestRecords = BestRecords
  { BestRecords -> ProgressMetric
_scenarioBestByTime :: ProgressMetric
  , BestRecords -> ProgressMetric
_scenarioBestByTicks :: ProgressMetric
  , BestRecords -> ProgressMetric
_scenarioBestByCharCount :: ProgressMetric
  , BestRecords -> ProgressMetric
_scenarioBestByAstSize :: ProgressMetric
  }
  deriving (BestRecords -> BestRecords -> Bool
(BestRecords -> BestRecords -> Bool)
-> (BestRecords -> BestRecords -> Bool) -> Eq BestRecords
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BestRecords -> BestRecords -> Bool
== :: BestRecords -> BestRecords -> Bool
$c/= :: BestRecords -> BestRecords -> Bool
/= :: BestRecords -> BestRecords -> Bool
Eq, Eq BestRecords
Eq BestRecords =>
(BestRecords -> BestRecords -> Ordering)
-> (BestRecords -> BestRecords -> Bool)
-> (BestRecords -> BestRecords -> Bool)
-> (BestRecords -> BestRecords -> Bool)
-> (BestRecords -> BestRecords -> Bool)
-> (BestRecords -> BestRecords -> BestRecords)
-> (BestRecords -> BestRecords -> BestRecords)
-> Ord BestRecords
BestRecords -> BestRecords -> Bool
BestRecords -> BestRecords -> Ordering
BestRecords -> BestRecords -> BestRecords
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 :: BestRecords -> BestRecords -> Ordering
compare :: BestRecords -> BestRecords -> Ordering
$c< :: BestRecords -> BestRecords -> Bool
< :: BestRecords -> BestRecords -> Bool
$c<= :: BestRecords -> BestRecords -> Bool
<= :: BestRecords -> BestRecords -> Bool
$c> :: BestRecords -> BestRecords -> Bool
> :: BestRecords -> BestRecords -> Bool
$c>= :: BestRecords -> BestRecords -> Bool
>= :: BestRecords -> BestRecords -> Bool
$cmax :: BestRecords -> BestRecords -> BestRecords
max :: BestRecords -> BestRecords -> BestRecords
$cmin :: BestRecords -> BestRecords -> BestRecords
min :: BestRecords -> BestRecords -> BestRecords
Ord, ReadPrec [BestRecords]
ReadPrec BestRecords
Int -> ReadS BestRecords
ReadS [BestRecords]
(Int -> ReadS BestRecords)
-> ReadS [BestRecords]
-> ReadPrec BestRecords
-> ReadPrec [BestRecords]
-> Read BestRecords
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS BestRecords
readsPrec :: Int -> ReadS BestRecords
$creadList :: ReadS [BestRecords]
readList :: ReadS [BestRecords]
$creadPrec :: ReadPrec BestRecords
readPrec :: ReadPrec BestRecords
$creadListPrec :: ReadPrec [BestRecords]
readListPrec :: ReadPrec [BestRecords]
Read, (forall x. BestRecords -> Rep BestRecords x)
-> (forall x. Rep BestRecords x -> BestRecords)
-> Generic BestRecords
forall x. Rep BestRecords x -> BestRecords
forall x. BestRecords -> Rep BestRecords x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BestRecords -> Rep BestRecords x
from :: forall x. BestRecords -> Rep BestRecords x
$cto :: forall x. Rep BestRecords x -> BestRecords
to :: forall x. Rep BestRecords x -> BestRecords
Generic)

instance Show BestRecords where
  show :: BestRecords -> [Char]
show (BestRecords ProgressMetric
a ProgressMetric
b ProgressMetric
c ProgressMetric
d) =
    [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$
      ShowS -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map
        ShowS
angleBracket
        [ ProgressMetric -> [Char]
forall a. Show a => a -> [Char]
show ProgressMetric
a
        , ProgressMetric -> [Char]
forall a. Show a => a -> [Char]
show ProgressMetric
b
        , ProgressMetric -> [Char]
forall a. Show a => a -> [Char]
show ProgressMetric
c
        , ProgressMetric -> [Char]
forall a. Show a => a -> [Char]
show ProgressMetric
d
        ]
   where
    angleBracket :: String -> String
    angleBracket :: ShowS
angleBracket [Char]
x = [Char]
"<" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
x [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
">"

emptyBest :: ZonedTime -> BestRecords
emptyBest :: ZonedTime -> BestRecords
emptyBest ZonedTime
t = ProgressMetric
-> ProgressMetric
-> ProgressMetric
-> ProgressMetric
-> BestRecords
BestRecords ProgressMetric
x ProgressMetric
x ProgressMetric
x ProgressMetric
x
 where
  x :: ProgressMetric
x = Progress -> ProgressStats -> ProgressMetric
forall a. Progress -> a -> Metric a
Metric Progress
Attempted (ProgressStats -> ProgressMetric)
-> ProgressStats -> ProgressMetric
forall a b. (a -> b) -> a -> b
$ ZonedTime -> AttemptMetrics -> ProgressStats
ProgressStats ZonedTime
t AttemptMetrics
emptyAttemptMetric

updateBest :: ProgressMetric -> BestRecords -> BestRecords
updateBest :: ProgressMetric -> BestRecords -> BestRecords
updateBest ProgressMetric
newPlayMetric (BestRecords ProgressMetric
oldA ProgressMetric
oldB ProgressMetric
oldC ProgressMetric
oldD) =
  ProgressMetric
-> ProgressMetric
-> ProgressMetric
-> ProgressMetric
-> BestRecords
BestRecords
    (ProgressMetric
-> ((NominalDiffTime -> Const NominalDiffTime NominalDiffTime)
    -> DurationMetrics -> Const NominalDiffTime DurationMetrics)
-> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> ProgressMetric
bestTime ProgressMetric
oldA (NominalDiffTime -> Const NominalDiffTime NominalDiffTime)
-> DurationMetrics -> Const NominalDiffTime DurationMetrics
Lens' DurationMetrics NominalDiffTime
scenarioElapsed)
    (ProgressMetric
-> ((TickNumber -> Const TickNumber TickNumber)
    -> DurationMetrics -> Const TickNumber DurationMetrics)
-> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> ProgressMetric
bestTime ProgressMetric
oldB (TickNumber -> Const TickNumber TickNumber)
-> DurationMetrics -> Const TickNumber DurationMetrics
Lens' DurationMetrics TickNumber
scenarioElapsedTicks)
    (ProgressMetric -> (ScenarioCodeMetrics -> Int) -> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric -> (ScenarioCodeMetrics -> a) -> ProgressMetric
bestSize ProgressMetric
oldC ScenarioCodeMetrics -> Int
sourceTextLength)
    (ProgressMetric -> (ScenarioCodeMetrics -> Int) -> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric -> (ScenarioCodeMetrics -> a) -> ProgressMetric
bestSize ProgressMetric
oldD ScenarioCodeMetrics -> Int
astSize)
 where
  f :: ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
f ProgressMetric
x ProgressStats -> Maybe a
y = (ProgressStats -> Maybe a)
-> ProgressMetric -> ProgressMetric -> ProgressMetric
forall a b.
Ord a =>
(b -> Maybe a) -> Metric b -> Metric b -> Metric b
chooseBetter ProgressStats -> Maybe a
y ProgressMetric
newPlayMetric ProgressMetric
x
  bestTime :: ProgressMetric
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> ProgressMetric
bestTime ProgressMetric
x (a -> Const a a) -> DurationMetrics -> Const a DurationMetrics
y = ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
f ProgressMetric
x (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (ProgressStats -> a) -> ProgressStats -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a ProgressStats a -> ProgressStats -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((AttemptMetrics -> Const a AttemptMetrics)
-> ProgressStats -> Const a ProgressStats
Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics ((AttemptMetrics -> Const a AttemptMetrics)
 -> ProgressStats -> Const a ProgressStats)
-> ((a -> Const a a) -> AttemptMetrics -> Const a AttemptMetrics)
-> Getting a ProgressStats a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DurationMetrics -> Const a DurationMetrics)
-> AttemptMetrics -> Const a AttemptMetrics
Lens' AttemptMetrics DurationMetrics
scenarioDurationMetrics ((DurationMetrics -> Const a DurationMetrics)
 -> AttemptMetrics -> Const a AttemptMetrics)
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> (a -> Const a a)
-> AttemptMetrics
-> Const a AttemptMetrics
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> DurationMetrics -> Const a DurationMetrics
y))
  bestSize :: ProgressMetric -> (ScenarioCodeMetrics -> a) -> ProgressMetric
bestSize ProgressMetric
x ScenarioCodeMetrics -> a
y = ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
forall {a}.
Ord a =>
ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
f ProgressMetric
x ((ScenarioCodeMetrics -> a) -> Maybe ScenarioCodeMetrics -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScenarioCodeMetrics -> a
y (Maybe ScenarioCodeMetrics -> Maybe a)
-> (ProgressStats -> Maybe ScenarioCodeMetrics)
-> ProgressStats
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe ScenarioCodeMetrics)
  ProgressStats
  (Maybe ScenarioCodeMetrics)
-> ProgressStats -> Maybe ScenarioCodeMetrics
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((AttemptMetrics
 -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
-> ProgressStats -> Const (Maybe ScenarioCodeMetrics) ProgressStats
Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics ((AttemptMetrics
  -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
 -> ProgressStats
 -> Const (Maybe ScenarioCodeMetrics) ProgressStats)
-> ((Maybe ScenarioCodeMetrics
     -> Const (Maybe ScenarioCodeMetrics) (Maybe ScenarioCodeMetrics))
    -> AttemptMetrics
    -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
-> Getting
     (Maybe ScenarioCodeMetrics)
     ProgressStats
     (Maybe ScenarioCodeMetrics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScenarioCodeMetrics
 -> Const (Maybe ScenarioCodeMetrics) (Maybe ScenarioCodeMetrics))
-> AttemptMetrics
-> Const (Maybe ScenarioCodeMetrics) AttemptMetrics
Lens' AttemptMetrics (Maybe ScenarioCodeMetrics)
scenarioCodeMetrics))

makeLensesNoSigs ''BestRecords

-- | The best status of the scenario, measured in real world time.
scenarioBestByTime :: Lens' BestRecords ProgressMetric

-- | The best status of the scenario, measured in game ticks.
scenarioBestByTicks :: Lens' BestRecords ProgressMetric

-- | The best code size of the scenario, measured in character count.
scenarioBestByCharCount :: Lens' BestRecords ProgressMetric

-- | The best code size of the scenario, measured in AST size.
scenarioBestByAstSize :: Lens' BestRecords ProgressMetric

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

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

-- | Uses the start time of the play-attempt to de-dupe
-- records that are from the same game. The start time should
-- be sufficient to uniquely identify a game.
getBestGroups ::
  BestRecords ->
  [(Metric ProgressStats, NonEmpty BestByCriteria)]
getBestGroups :: BestRecords -> [(ProgressMetric, NonEmpty BestByCriteria)]
getBestGroups =
  [(BestByCriteria, ProgressMetric)]
-> [(ProgressMetric, NonEmpty BestByCriteria)]
forall {a}. [(a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)]
rearrangeTuples ([(BestByCriteria, ProgressMetric)]
 -> [(ProgressMetric, NonEmpty BestByCriteria)])
-> (BestRecords -> [(BestByCriteria, ProgressMetric)])
-> BestRecords
-> [(ProgressMetric, NonEmpty BestByCriteria)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map BestByCriteria ProgressMetric
-> [(BestByCriteria, ProgressMetric)]
forall k a. Map k a -> [(k, a)]
M.toList (Map BestByCriteria ProgressMetric
 -> [(BestByCriteria, ProgressMetric)])
-> (BestRecords -> Map BestByCriteria ProgressMetric)
-> BestRecords
-> [(BestByCriteria, ProgressMetric)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestRecords -> Map BestByCriteria ProgressMetric
bestToMap
 where
  groupByStartTime :: [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)]
groupByStartTime = ((a, ProgressMetric) -> ZonedTime)
-> [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)]
forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith (((a, ProgressMetric) -> ZonedTime)
 -> [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)])
-> ((a, ProgressMetric) -> ZonedTime)
-> [(a, ProgressMetric)]
-> [NonEmpty (a, ProgressMetric)]
forall a b. (a -> b) -> a -> b
$ Getting ZonedTime ProgressStats ZonedTime
-> ProgressStats -> ZonedTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ZonedTime ProgressStats ZonedTime
Lens' ProgressStats ZonedTime
scenarioStarted (ProgressStats -> ZonedTime)
-> ((a, ProgressMetric) -> ProgressStats)
-> (a, ProgressMetric)
-> ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProgressStats ProgressMetric ProgressStats
-> ProgressMetric -> ProgressStats
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ProgressStats ProgressMetric ProgressStats
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Metric a -> f (Metric a)
metricData (ProgressMetric -> ProgressStats)
-> ((a, ProgressMetric) -> ProgressMetric)
-> (a, ProgressMetric)
-> ProgressStats
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, ProgressMetric) -> ProgressMetric
forall a b. (a, b) -> b
snd
  rearrangeTuples :: [(a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)]
rearrangeTuples = (NonEmpty (a, ProgressMetric) -> (ProgressMetric, NonEmpty a))
-> [NonEmpty (a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)]
forall a b. (a -> b) -> [a] -> [b]
map ((a, ProgressMetric) -> ProgressMetric
forall a b. (a, b) -> b
snd ((a, ProgressMetric) -> ProgressMetric)
-> (NonEmpty (a, ProgressMetric) -> (a, ProgressMetric))
-> NonEmpty (a, ProgressMetric)
-> ProgressMetric
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (a, ProgressMetric) -> (a, ProgressMetric)
forall a. NonEmpty a -> a
NE.head (NonEmpty (a, ProgressMetric) -> ProgressMetric)
-> (NonEmpty (a, ProgressMetric) -> NonEmpty a)
-> NonEmpty (a, ProgressMetric)
-> (ProgressMetric, NonEmpty a)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((a, ProgressMetric) -> a)
-> NonEmpty (a, ProgressMetric) -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (a, ProgressMetric) -> a
forall a b. (a, b) -> a
fst) ([NonEmpty (a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)])
-> ([(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)])
-> [(a, ProgressMetric)]
-> [(ProgressMetric, NonEmpty a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)]
forall {a}. [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)]
groupByStartTime

  bestToMap :: BestRecords -> Map BestByCriteria ProgressMetric
  bestToMap :: BestRecords -> Map BestByCriteria ProgressMetric
bestToMap (BestRecords ProgressMetric
t1 ProgressMetric
t2 ProgressMetric
s1 ProgressMetric
s2) =
    [(BestByCriteria, ProgressMetric)]
-> Map BestByCriteria ProgressMetric
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(BestByCriteria, ProgressMetric)]
 -> Map BestByCriteria ProgressMetric)
-> [(BestByCriteria, ProgressMetric)]
-> Map BestByCriteria ProgressMetric
forall a b. (a -> b) -> a -> b
$ [(BestByCriteria, ProgressMetric)]
durationElements [(BestByCriteria, ProgressMetric)]
-> [(BestByCriteria, ProgressMetric)]
-> [(BestByCriteria, ProgressMetric)]
forall a. Semigroup a => a -> a -> a
<> ((BestByCriteria, ProgressMetric)
 -> Maybe (BestByCriteria, ProgressMetric))
-> [(BestByCriteria, ProgressMetric)]
-> [(BestByCriteria, ProgressMetric)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ProgressMetric -> Maybe ProgressMetric)
-> (BestByCriteria, ProgressMetric)
-> Maybe (BestByCriteria, ProgressMetric)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (BestByCriteria, a) -> f (BestByCriteria, b)
traverse ProgressMetric -> Maybe ProgressMetric
ensurePresent) [(BestByCriteria, ProgressMetric)]
codeSizeElements
   where
    durationElements :: [(BestByCriteria, ProgressMetric)]
durationElements =
      [ (BestByCriteria
BestByTime, ProgressMetric
t1)
      , (BestByCriteria
BestByTicks, ProgressMetric
t2)
      ]
    codeSizeElements :: [(BestByCriteria, ProgressMetric)]
codeSizeElements =
      [ (BestByCriteria
BestByCharCount, ProgressMetric
s1)
      , (BestByCriteria
BestByAstSize, ProgressMetric
s2)
      ]

    ensurePresent :: ProgressMetric -> Maybe ProgressMetric
ensurePresent ProgressMetric
x =
      (ProgressMetric
x ProgressMetric
-> Getting
     (Maybe ScenarioCodeMetrics)
     ProgressMetric
     (Maybe ScenarioCodeMetrics)
-> Maybe ScenarioCodeMetrics
forall s a. s -> Getting a s a -> a
^. (ProgressStats -> Const (Maybe ScenarioCodeMetrics) ProgressStats)
-> ProgressMetric
-> Const (Maybe ScenarioCodeMetrics) ProgressMetric
forall a (f :: * -> *).
Functor f =>
(a -> f a) -> Metric a -> f (Metric a)
metricData ((ProgressStats -> Const (Maybe ScenarioCodeMetrics) ProgressStats)
 -> ProgressMetric
 -> Const (Maybe ScenarioCodeMetrics) ProgressMetric)
-> Getting
     (Maybe ScenarioCodeMetrics)
     ProgressStats
     (Maybe ScenarioCodeMetrics)
-> Getting
     (Maybe ScenarioCodeMetrics)
     ProgressMetric
     (Maybe ScenarioCodeMetrics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttemptMetrics
 -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
-> ProgressStats -> Const (Maybe ScenarioCodeMetrics) ProgressStats
Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics ((AttemptMetrics
  -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
 -> ProgressStats
 -> Const (Maybe ScenarioCodeMetrics) ProgressStats)
-> ((Maybe ScenarioCodeMetrics
     -> Const (Maybe ScenarioCodeMetrics) (Maybe ScenarioCodeMetrics))
    -> AttemptMetrics
    -> Const (Maybe ScenarioCodeMetrics) AttemptMetrics)
-> Getting
     (Maybe ScenarioCodeMetrics)
     ProgressStats
     (Maybe ScenarioCodeMetrics)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScenarioCodeMetrics
 -> Const (Maybe ScenarioCodeMetrics) (Maybe ScenarioCodeMetrics))
-> AttemptMetrics
-> Const (Maybe ScenarioCodeMetrics) AttemptMetrics
Lens' AttemptMetrics (Maybe ScenarioCodeMetrics)
scenarioCodeMetrics) Maybe ScenarioCodeMetrics
-> Maybe ProgressMetric -> Maybe ProgressMetric
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProgressMetric -> Maybe ProgressMetric
forall a. a -> Maybe a
Just ProgressMetric
x