{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Data types and instances for specific scoring methods
module Swarm.Game.Scenario.Scoring.ConcreteMetrics where

import Control.Lens hiding (from, (<.>))
import Data.Aeson
import Data.Char (toLower)
import Data.Time (NominalDiffTime)
import GHC.Generics (Generic)
import Swarm.Game.CESK (TickNumber (..))
import Swarm.Game.Scenario.Scoring.CodeSize

scenarioOptions :: Options
scenarioOptions :: Options
scenarioOptions =
  Options
defaultOptions
    { fieldLabelModifier :: String -> String
fieldLabelModifier = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop (forall (t :: * -> *) a. Foldable t => t a -> Int
length (String
"_scenario" :: String))
    }

data DurationMetrics = DurationMetrics
  { DurationMetrics -> NominalDiffTime
_scenarioElapsed :: NominalDiffTime
  -- ^ Time elapsed until winning the scenario.
  , DurationMetrics -> TickNumber
_scenarioElapsedTicks :: TickNumber
  -- ^ Ticks elapsed until winning the scenario.
  }
  deriving (DurationMetrics -> DurationMetrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DurationMetrics -> DurationMetrics -> Bool
$c/= :: DurationMetrics -> DurationMetrics -> Bool
== :: DurationMetrics -> DurationMetrics -> Bool
$c== :: DurationMetrics -> DurationMetrics -> Bool
Eq, Eq DurationMetrics
DurationMetrics -> DurationMetrics -> Bool
DurationMetrics -> DurationMetrics -> Ordering
DurationMetrics -> DurationMetrics -> DurationMetrics
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 :: DurationMetrics -> DurationMetrics -> DurationMetrics
$cmin :: DurationMetrics -> DurationMetrics -> DurationMetrics
max :: DurationMetrics -> DurationMetrics -> DurationMetrics
$cmax :: DurationMetrics -> DurationMetrics -> DurationMetrics
>= :: DurationMetrics -> DurationMetrics -> Bool
$c>= :: DurationMetrics -> DurationMetrics -> Bool
> :: DurationMetrics -> DurationMetrics -> Bool
$c> :: DurationMetrics -> DurationMetrics -> Bool
<= :: DurationMetrics -> DurationMetrics -> Bool
$c<= :: DurationMetrics -> DurationMetrics -> Bool
< :: DurationMetrics -> DurationMetrics -> Bool
$c< :: DurationMetrics -> DurationMetrics -> Bool
compare :: DurationMetrics -> DurationMetrics -> Ordering
$ccompare :: DurationMetrics -> DurationMetrics -> Ordering
Ord, Int -> DurationMetrics -> String -> String
[DurationMetrics] -> String -> String
DurationMetrics -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DurationMetrics] -> String -> String
$cshowList :: [DurationMetrics] -> String -> String
show :: DurationMetrics -> String
$cshow :: DurationMetrics -> String
showsPrec :: Int -> DurationMetrics -> String -> String
$cshowsPrec :: Int -> DurationMetrics -> String -> String
Show, ReadPrec [DurationMetrics]
ReadPrec DurationMetrics
Int -> ReadS DurationMetrics
ReadS [DurationMetrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DurationMetrics]
$creadListPrec :: ReadPrec [DurationMetrics]
readPrec :: ReadPrec DurationMetrics
$creadPrec :: ReadPrec DurationMetrics
readList :: ReadS [DurationMetrics]
$creadList :: ReadS [DurationMetrics]
readsPrec :: Int -> ReadS DurationMetrics
$creadsPrec :: Int -> ReadS DurationMetrics
Read, forall x. Rep DurationMetrics x -> DurationMetrics
forall x. DurationMetrics -> Rep DurationMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DurationMetrics x -> DurationMetrics
$cfrom :: forall x. DurationMetrics -> Rep DurationMetrics x
Generic)

makeLenses ''DurationMetrics

emptyDurationMetric :: DurationMetrics
emptyDurationMetric :: DurationMetrics
emptyDurationMetric = NominalDiffTime -> TickNumber -> DurationMetrics
DurationMetrics NominalDiffTime
0 forall a b. (a -> b) -> a -> b
$ Int64 -> TickNumber
TickNumber Int64
0

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

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

data AttemptMetrics = AttemptMetrics
  { AttemptMetrics -> DurationMetrics
_scenarioDurationMetrics :: DurationMetrics
  , AttemptMetrics -> Maybe ScenarioCodeMetrics
_scenarioCodeMetrics :: Maybe ScenarioCodeMetrics
  -- ^ Size of the user's program.
  }
  deriving (AttemptMetrics -> AttemptMetrics -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttemptMetrics -> AttemptMetrics -> Bool
$c/= :: AttemptMetrics -> AttemptMetrics -> Bool
== :: AttemptMetrics -> AttemptMetrics -> Bool
$c== :: AttemptMetrics -> AttemptMetrics -> Bool
Eq, Eq AttemptMetrics
AttemptMetrics -> AttemptMetrics -> Bool
AttemptMetrics -> AttemptMetrics -> Ordering
AttemptMetrics -> AttemptMetrics -> AttemptMetrics
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 :: AttemptMetrics -> AttemptMetrics -> AttemptMetrics
$cmin :: AttemptMetrics -> AttemptMetrics -> AttemptMetrics
max :: AttemptMetrics -> AttemptMetrics -> AttemptMetrics
$cmax :: AttemptMetrics -> AttemptMetrics -> AttemptMetrics
>= :: AttemptMetrics -> AttemptMetrics -> Bool
$c>= :: AttemptMetrics -> AttemptMetrics -> Bool
> :: AttemptMetrics -> AttemptMetrics -> Bool
$c> :: AttemptMetrics -> AttemptMetrics -> Bool
<= :: AttemptMetrics -> AttemptMetrics -> Bool
$c<= :: AttemptMetrics -> AttemptMetrics -> Bool
< :: AttemptMetrics -> AttemptMetrics -> Bool
$c< :: AttemptMetrics -> AttemptMetrics -> Bool
compare :: AttemptMetrics -> AttemptMetrics -> Ordering
$ccompare :: AttemptMetrics -> AttemptMetrics -> Ordering
Ord, Int -> AttemptMetrics -> String -> String
[AttemptMetrics] -> String -> String
AttemptMetrics -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AttemptMetrics] -> String -> String
$cshowList :: [AttemptMetrics] -> String -> String
show :: AttemptMetrics -> String
$cshow :: AttemptMetrics -> String
showsPrec :: Int -> AttemptMetrics -> String -> String
$cshowsPrec :: Int -> AttemptMetrics -> String -> String
Show, ReadPrec [AttemptMetrics]
ReadPrec AttemptMetrics
Int -> ReadS AttemptMetrics
ReadS [AttemptMetrics]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AttemptMetrics]
$creadListPrec :: ReadPrec [AttemptMetrics]
readPrec :: ReadPrec AttemptMetrics
$creadPrec :: ReadPrec AttemptMetrics
readList :: ReadS [AttemptMetrics]
$creadList :: ReadS [AttemptMetrics]
readsPrec :: Int -> ReadS AttemptMetrics
$creadsPrec :: Int -> ReadS AttemptMetrics
Read, forall x. Rep AttemptMetrics x -> AttemptMetrics
forall x. AttemptMetrics -> Rep AttemptMetrics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AttemptMetrics x -> AttemptMetrics
$cfrom :: forall x. AttemptMetrics -> Rep AttemptMetrics x
Generic)

emptyAttemptMetric :: AttemptMetrics
emptyAttemptMetric :: AttemptMetrics
emptyAttemptMetric = DurationMetrics -> Maybe ScenarioCodeMetrics -> AttemptMetrics
AttemptMetrics DurationMetrics
emptyDurationMetric forall a. Maybe a
Nothing

makeLenses ''AttemptMetrics

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

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