GenericMetrics.hs

-- | 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 (Eq, Ord, Show, Read, Generic)

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

instance FromJSON Progress where
  parseJSON = genericParseJSON untaggedJsonOptions

instance ToJSON Progress where
  toJSON = genericToJSON untaggedJsonOptions

data Metric a = Metric Progress a
  deriving (Eq, Ord, Show, Read, Generic, FromJSON, ToJSON)

getMetric :: Metric a -> a
getMetric (Metric _ x) = 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 criteria (Metric Attempted x) (Metric Attempted y) =
  Metric Attempted $ maxOn criteria x y
chooseBetter criteria (Metric Completed x) (Metric Completed y) =
  Metric Completed $ maxOn (fmap Down . criteria) x y
-- Having exhausted the possibilities where either both
-- are Completed or both are Attempted, now we can just
-- choose the Completed one.
chooseBetter _ x@(Metric Completed _) _ = x
chooseBetter _ _ y@(Metric Completed _) = y