{-# 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
(==) = 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

-- * High scores by various criteria

data BestByCriteria
  = BestByTime
  | BestByTicks
  | BestByCharCount
  | BestByAstSize
  deriving (BestByCriteria -> BestByCriteria -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BestByCriteria -> BestByCriteria -> Bool
$c/= :: BestByCriteria -> BestByCriteria -> Bool
== :: BestByCriteria -> BestByCriteria -> Bool
$c== :: BestByCriteria -> BestByCriteria -> Bool
Eq, Eq 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
min :: BestByCriteria -> BestByCriteria -> BestByCriteria
$cmin :: BestByCriteria -> BestByCriteria -> BestByCriteria
max :: BestByCriteria -> BestByCriteria -> BestByCriteria
$cmax :: BestByCriteria -> BestByCriteria -> BestByCriteria
>= :: BestByCriteria -> BestByCriteria -> Bool
$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
compare :: BestByCriteria -> BestByCriteria -> Ordering
$ccompare :: BestByCriteria -> BestByCriteria -> Ordering
Ord, BestByCriteria
forall a. a -> a -> Bounded a
maxBound :: BestByCriteria
$cmaxBound :: BestByCriteria
minBound :: BestByCriteria
$cminBound :: BestByCriteria
Bounded, Int -> BestByCriteria
BestByCriteria -> Int
BestByCriteria -> [BestByCriteria]
BestByCriteria -> BestByCriteria
BestByCriteria -> BestByCriteria -> [BestByCriteria]
BestByCriteria
-> BestByCriteria -> BestByCriteria -> [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
enumFromThenTo :: BestByCriteria
-> BestByCriteria -> BestByCriteria -> [BestByCriteria]
$cenumFromThenTo :: BestByCriteria
-> BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFromTo :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
$cenumFromTo :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFromThen :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
$cenumFromThen :: BestByCriteria -> BestByCriteria -> [BestByCriteria]
enumFrom :: BestByCriteria -> [BestByCriteria]
$cenumFrom :: BestByCriteria -> [BestByCriteria]
fromEnum :: BestByCriteria -> Int
$cfromEnum :: BestByCriteria -> Int
toEnum :: Int -> BestByCriteria
$ctoEnum :: Int -> BestByCriteria
pred :: BestByCriteria -> BestByCriteria
$cpred :: BestByCriteria -> BestByCriteria
succ :: BestByCriteria -> BestByCriteria
$csucc :: BestByCriteria -> BestByCriteria
Enum, Int -> BestByCriteria -> ShowS
[BestByCriteria] -> ShowS
BestByCriteria -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [BestByCriteria] -> ShowS
$cshowList :: [BestByCriteria] -> ShowS
show :: BestByCriteria -> [Char]
$cshow :: BestByCriteria -> [Char]
showsPrec :: Int -> BestByCriteria -> ShowS
$cshowsPrec :: Int -> 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgressStats -> ProgressStats -> Bool
$c/= :: ProgressStats -> ProgressStats -> Bool
== :: ProgressStats -> ProgressStats -> Bool
$c== :: ProgressStats -> ProgressStats -> Bool
Eq, Eq 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
min :: ProgressStats -> ProgressStats -> ProgressStats
$cmin :: ProgressStats -> ProgressStats -> ProgressStats
max :: ProgressStats -> ProgressStats -> ProgressStats
$cmax :: ProgressStats -> ProgressStats -> ProgressStats
>= :: ProgressStats -> ProgressStats -> Bool
$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
compare :: ProgressStats -> ProgressStats -> Ordering
$ccompare :: ProgressStats -> ProgressStats -> Ordering
Ord, Int -> ProgressStats -> ShowS
[ProgressStats] -> ShowS
ProgressStats -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProgressStats] -> ShowS
$cshowList :: [ProgressStats] -> ShowS
show :: ProgressStats -> [Char]
$cshow :: ProgressStats -> [Char]
showsPrec :: Int -> ProgressStats -> ShowS
$cshowsPrec :: Int -> ProgressStats -> ShowS
Show, ReadPrec [ProgressStats]
ReadPrec ProgressStats
Int -> ReadS ProgressStats
ReadS [ProgressStats]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ProgressStats]
$creadListPrec :: ReadPrec [ProgressStats]
readPrec :: ReadPrec ProgressStats
$creadPrec :: ReadPrec ProgressStats
readList :: ReadS [ProgressStats]
$creadList :: ReadS [ProgressStats]
readsPrec :: Int -> ReadS ProgressStats
$creadsPrec :: Int -> ReadS ProgressStats
Read, 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
$cto :: forall x. Rep ProgressStats x -> ProgressStats
$cfrom :: forall x. ProgressStats -> Rep ProgressStats x
Generic)

makeLenses ''ProgressStats

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

instance ToJSON ProgressStats where
  toEncoding :: ProgressStats -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
  toJSON :: ProgressStats -> Value
toJSON = 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BestRecords -> BestRecords -> Bool
$c/= :: BestRecords -> BestRecords -> Bool
== :: BestRecords -> BestRecords -> Bool
$c== :: BestRecords -> BestRecords -> Bool
Eq, Eq 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
min :: BestRecords -> BestRecords -> BestRecords
$cmin :: BestRecords -> BestRecords -> BestRecords
max :: BestRecords -> BestRecords -> BestRecords
$cmax :: BestRecords -> BestRecords -> BestRecords
>= :: BestRecords -> BestRecords -> Bool
$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
compare :: BestRecords -> BestRecords -> Ordering
$ccompare :: BestRecords -> BestRecords -> Ordering
Ord, ReadPrec [BestRecords]
ReadPrec BestRecords
Int -> ReadS BestRecords
ReadS [BestRecords]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BestRecords]
$creadListPrec :: ReadPrec [BestRecords]
readPrec :: ReadPrec BestRecords
$creadPrec :: ReadPrec BestRecords
readList :: ReadS [BestRecords]
$creadList :: ReadS [BestRecords]
readsPrec :: Int -> ReadS BestRecords
$creadsPrec :: Int -> ReadS BestRecords
Read, 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
$cto :: forall x. Rep BestRecords x -> BestRecords
$cfrom :: forall x. BestRecords -> Rep BestRecords x
Generic)

instance Show BestRecords where
  show :: BestRecords -> [Char]
show (BestRecords ProgressMetric
a ProgressMetric
b ProgressMetric
c ProgressMetric
d) =
    [[Char]] -> [Char]
unlines forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map
        ShowS
angleBracket
        [ forall a. Show a => a -> [Char]
show ProgressMetric
a
        , forall a. Show a => a -> [Char]
show ProgressMetric
b
        , forall a. Show a => a -> [Char]
show ProgressMetric
c
        , forall a. Show a => a -> [Char]
show ProgressMetric
d
        ]
   where
    angleBracket :: String -> String
    angleBracket :: ShowS
angleBracket [Char]
x = [Char]
"<" forall a. Semigroup a => a -> a -> a
<> [Char]
x 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 = forall a. Progress -> a -> Metric a
Metric Progress
Attempted 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
    (forall {a}.
Ord a =>
ProgressMetric
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> ProgressMetric
bestTime ProgressMetric
oldA Lens' DurationMetrics NominalDiffTime
scenarioElapsed)
    (forall {a}.
Ord a =>
ProgressMetric
-> ((a -> Const a a) -> DurationMetrics -> Const a DurationMetrics)
-> ProgressMetric
bestTime ProgressMetric
oldB Lens' DurationMetrics TickNumber
scenarioElapsedTicks)
    (forall {a}.
Ord a =>
ProgressMetric -> (ScenarioCodeMetrics -> a) -> ProgressMetric
bestSize ProgressMetric
oldC ScenarioCodeMetrics -> Int
sourceTextLength)
    (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 = 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 = forall {a}.
Ord a =>
ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
f ProgressMetric
x (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AttemptMetrics DurationMetrics
scenarioDurationMetrics 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 = forall {a}.
Ord a =>
ProgressMetric -> (ProgressStats -> Maybe a) -> ProgressMetric
f ProgressMetric
x (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ScenarioCodeMetrics -> a
y forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
scenarioOptions

instance ToJSON BestRecords where
  toEncoding :: BestRecords -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
scenarioOptions
  toJSON :: BestRecords -> Value
toJSON = 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 =
  forall {a}. [(a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)]
rearrangeTuples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. BestRecords -> Map BestByCriteria ProgressMetric
bestToMap
 where
  groupByStartTime :: [(a, ProgressMetric)] -> [NonEmpty (a, ProgressMetric)]
groupByStartTime = forall b a. Ord b => (a -> b) -> [a] -> [NonEmpty a]
NE.groupAllWith forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ProgressStats ZonedTime
scenarioStarted forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Metric a -> a
getMetric forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
  rearrangeTuples :: [(a, ProgressMetric)] -> [(ProgressMetric, NonEmpty a)]
rearrangeTuples = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
NE.head forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) =
    forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ [(BestByCriteria, ProgressMetric)]
durationElements forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 =
      (forall a. Metric a -> a
getMetric ProgressMetric
x forall s a. s -> Getting a s a -> a
^. Lens' ProgressStats AttemptMetrics
scenarioAttemptMetrics forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AttemptMetrics (Maybe ScenarioCodeMetrics)
scenarioCodeMetrics) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just ProgressMetric
x