content: {-# LANGUAGE TemplateHaskell #-}
  
  -- |
  -- SPDX-License-Identifier: BSD-3-Clause
  --
  -- Data types and functions applicable across different
  -- scoring methods.
  module Swarm.Game.Scenario.Scoring.GenericMetrics (
    Progress (..),
    Metric (Metric),
    metricProgress,
    metricData,
    chooseBetter,
  ) where
  
  import Control.Applicative ((<|>))
  import Control.Lens
  import Data.Aeson
  import Data.List.Extra (dropPrefix)
  import Data.Ord (Down (Down))
  import GHC.Generics (Generic)
  import Swarm.Util (maxOn)
  import Swarm.Util.JSON (optionsMinimize, optionsUntagged)
  import Swarm.Util.Lens (makeLensesNoSigs)
  
  -- | This is a subset of the "ScenarioStatus" type
  -- that excludes the "NotStarted" case.
  data Progress
    = Attempted
    | Completed
    deriving (Eq, Ord, Show, Read, Generic)
  
  instance FromJSON Progress where
    parseJSON = genericParseJSON optionsUntagged
  
  instance ToJSON Progress where
    toJSON = genericToJSON optionsUntagged
  
  data Metric a = Metric
    { _metricProgress :: Progress
    , _metricData :: a
    }
    deriving (Eq, Ord, Show, Read, Generic)
  
  metricSerializeOptions :: Options
  metricSerializeOptions = optionsMinimize {fieldLabelModifier = camelTo2 '_' . dropPrefix "_metric"}
  
  instance FromJSON a => FromJSON (Metric a) where
    parseJSON v =
      (uncurry Metric <$> parseJSON v) -- parse saves from time when metric did not have named fields
        <|> genericParseJSON metricSerializeOptions v
  
  instance ToJSON a => ToJSON (Metric a) where
    toJSON = genericToJSON metricSerializeOptions
  
  makeLensesNoSigs ''Metric
  
  -- | The player progress, so that we know if this game was completed.
  metricProgress :: Lens' (Metric a) Progress
  
  -- | Metric data, for example start and end time.
  metricData :: Lens' (Metric a) a
  
  -- | 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
  