-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Data types and functions applicable across different
-- scoring methods.
module Swarm.Game.Scenario.Scoring.GenericMetrics where

import Data.Aeson
import Data.Ord (Down (Down))
import GHC.Generics (Generic)
import Swarm.Util (maxOn)

-- | This is a subset of the "ScenarioStatus" type
-- that excludes the "NotStarted" case.
data Progress
  = Attempted
  | Completed
  deriving (Progress -> Progress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq, Eq Progress
Progress -> Progress -> Bool
Progress -> Progress -> Ordering
Progress -> Progress -> Progress
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 :: Progress -> Progress -> Progress
$cmin :: Progress -> Progress -> Progress
max :: Progress -> Progress -> Progress
$cmax :: Progress -> Progress -> Progress
>= :: Progress -> Progress -> Bool
$c>= :: Progress -> Progress -> Bool
> :: Progress -> Progress -> Bool
$c> :: Progress -> Progress -> Bool
<= :: Progress -> Progress -> Bool
$c<= :: Progress -> Progress -> Bool
< :: Progress -> Progress -> Bool
$c< :: Progress -> Progress -> Bool
compare :: Progress -> Progress -> Ordering
$ccompare :: Progress -> Progress -> Ordering
Ord, Int -> Progress -> ShowS
[Progress] -> ShowS
Progress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Progress] -> ShowS
$cshowList :: [Progress] -> ShowS
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> ShowS
$cshowsPrec :: Int -> Progress -> ShowS
Show, ReadPrec [Progress]
ReadPrec Progress
Int -> ReadS Progress
ReadS [Progress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Progress]
$creadListPrec :: ReadPrec [Progress]
readPrec :: ReadPrec Progress
$creadPrec :: ReadPrec Progress
readList :: ReadS [Progress]
$creadList :: ReadS [Progress]
readsPrec :: Int -> ReadS Progress
$creadsPrec :: Int -> ReadS Progress
Read, forall x. Rep Progress x -> Progress
forall x. Progress -> Rep Progress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Progress x -> Progress
$cfrom :: forall x. Progress -> Rep Progress x
Generic)

untaggedJsonOptions :: Options
untaggedJsonOptions :: Options
untaggedJsonOptions =
  Options
defaultOptions
    { sumEncoding :: SumEncoding
sumEncoding = SumEncoding
UntaggedValue
    }

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

instance ToJSON Progress where
  toJSON :: Progress -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
untaggedJsonOptions

data Metric a = Metric Progress a
  deriving (Metric a -> Metric a -> Bool
forall a. Eq a => Metric a -> Metric a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Metric a -> Metric a -> Bool
$c/= :: forall a. Eq a => Metric a -> Metric a -> Bool
== :: Metric a -> Metric a -> Bool
$c== :: forall a. Eq a => Metric a -> Metric a -> Bool
Eq, Metric a -> Metric a -> Bool
Metric a -> Metric a -> Ordering
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
forall {a}. Ord a => Eq (Metric a)
forall a. Ord a => Metric a -> Metric a -> Bool
forall a. Ord a => Metric a -> Metric a -> Ordering
forall a. Ord a => Metric a -> Metric a -> Metric a
min :: Metric a -> Metric a -> Metric a
$cmin :: forall a. Ord a => Metric a -> Metric a -> Metric a
max :: Metric a -> Metric a -> Metric a
$cmax :: forall a. Ord a => Metric a -> Metric a -> Metric a
>= :: Metric a -> Metric a -> Bool
$c>= :: forall a. Ord a => Metric a -> Metric a -> Bool
> :: Metric a -> Metric a -> Bool
$c> :: forall a. Ord a => Metric a -> Metric a -> Bool
<= :: Metric a -> Metric a -> Bool
$c<= :: forall a. Ord a => Metric a -> Metric a -> Bool
< :: Metric a -> Metric a -> Bool
$c< :: forall a. Ord a => Metric a -> Metric a -> Bool
compare :: Metric a -> Metric a -> Ordering
$ccompare :: forall a. Ord a => Metric a -> Metric a -> Ordering
Ord, Int -> Metric a -> ShowS
forall a. Show a => Int -> Metric a -> ShowS
forall a. Show a => [Metric a] -> ShowS
forall a. Show a => Metric a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Metric a] -> ShowS
$cshowList :: forall a. Show a => [Metric a] -> ShowS
show :: Metric a -> String
$cshow :: forall a. Show a => Metric a -> String
showsPrec :: Int -> Metric a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Metric a -> ShowS
Show, ReadPrec [Metric a]
ReadPrec (Metric a)
ReadS [Metric a]
forall a. Read a => ReadPrec [Metric a]
forall a. Read a => ReadPrec (Metric a)
forall a. Read a => Int -> ReadS (Metric a)
forall a. Read a => ReadS [Metric a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Metric a]
$creadListPrec :: forall a. Read a => ReadPrec [Metric a]
readPrec :: ReadPrec (Metric a)
$creadPrec :: forall a. Read a => ReadPrec (Metric a)
readList :: ReadS [Metric a]
$creadList :: forall a. Read a => ReadS [Metric a]
readsPrec :: Int -> ReadS (Metric a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Metric a)
Read, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Metric a) x -> Metric a
forall a x. Metric a -> Rep (Metric a) x
$cto :: forall a x. Rep (Metric a) x -> Metric a
$cfrom :: forall a x. Metric a -> Rep (Metric a) x
Generic, forall a. FromJSON a => Value -> Parser [Metric a]
forall a. FromJSON a => Value -> Parser (Metric a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Metric a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Metric a]
parseJSON :: Value -> Parser (Metric a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Metric a)
FromJSON, forall a. ToJSON a => [Metric a] -> Encoding
forall a. ToJSON a => [Metric a] -> Value
forall a. ToJSON a => Metric a -> Encoding
forall a. ToJSON a => Metric a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Metric a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Metric a] -> Encoding
toJSONList :: [Metric a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Metric a] -> Value
toEncoding :: Metric a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Metric a -> Encoding
toJSON :: Metric a -> Value
$ctoJSON :: forall a. ToJSON a => Metric a -> Value
ToJSON)

getMetric :: Metric a -> a
getMetric :: forall a. Metric a -> a
getMetric (Metric Progress
_ a
x) = a
x

-- | This encodes the notion of "more play is better"
-- for incomplete games (rationale: more play = more fun),
--  whereas "smaller inputs are better" for completed games.
--
-- Since 'Maybe' has its own 'Ord' instance where
-- @Nothing < Just x@ regardless of @x@, when we want to
-- choose the minimum value we @fmap Down@ to ensure that
-- the 'Just' is selected while inverting the ordering of
-- the inner member.
chooseBetter ::
  Ord a =>
  -- | criteria; record field extractor
  (b -> Maybe a) ->
  -- | x
  Metric b ->
  -- | y
  Metric b ->
  Metric b
chooseBetter :: forall a b.
Ord a =>
(b -> Maybe a) -> Metric b -> Metric b -> Metric b
chooseBetter b -> Maybe a
criteria (Metric Progress
Attempted b
x) (Metric Progress
Attempted b
y) =
  forall a. Progress -> a -> Metric a
Metric Progress
Attempted forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> a -> a -> a
maxOn b -> Maybe a
criteria b
x b
y
chooseBetter b -> Maybe a
criteria (Metric Progress
Completed b
x) (Metric Progress
Completed b
y) =
  forall a. Progress -> a -> Metric a
Metric Progress
Completed forall a b. (a -> b) -> a -> b
$ forall b a. Ord b => (a -> b) -> a -> a -> a
maxOn (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Down a
Down forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe a
criteria) b
x b
y
-- Having exhausted the possibilities where either both
-- are Completed or both are Attempted, now we can just
-- choose the Completed one.
chooseBetter b -> Maybe a
_ x :: Metric b
x@(Metric Progress
Completed b
_) Metric b
_ = Metric b
x
chooseBetter b -> Maybe a
_ Metric b
_ y :: Metric b
y@(Metric Progress
Completed b
_) = Metric b
y