{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Achievements player obtained
--
-- Metadata about achievements that the player has obtained.
module Swarm.Game.Achievement.Attainment (
  Attainment (..),
  achievement,
  maybeScenarioPath,
  obtainedAt,
) where

import Control.Lens (makeLenses)
import Data.Aeson (
  Options (..),
  defaultOptions,
  genericParseJSON,
  genericToJSON,
 )
import Data.Function (on)
import Data.Time (ZonedTime, zonedTimeToUTC)
import Data.Yaml as Y
import GHC.Generics (Generic)
import Swarm.Game.Achievement.Definitions (
  CategorizedAchievement,
 )

-- | A record holding an achievement along with some metadata to
--   record the time at which the achievement was obtained, and the
--   scenario in which it was achieved.
data Attainment = Attainment
  { Attainment -> CategorizedAchievement
_achievement :: CategorizedAchievement
  -- ^ The achievement.
  , Attainment -> Maybe FilePath
_maybeScenarioPath :: Maybe FilePath
  -- ^ From which scenario was it obtained?
  , Attainment -> ZonedTime
_obtainedAt :: ZonedTime
  -- ^ What time was it obtained?
  }
  deriving ((forall x. Attainment -> Rep Attainment x)
-> (forall x. Rep Attainment x -> Attainment) -> Generic Attainment
forall x. Rep Attainment x -> Attainment
forall x. Attainment -> Rep Attainment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Attainment -> Rep Attainment x
from :: forall x. Attainment -> Rep Attainment x
$cto :: forall x. Rep Attainment x -> Attainment
to :: forall x. Rep Attainment x -> Attainment
Generic)

makeLenses ''Attainment

instance Eq Attainment where
  == :: Attainment -> Attainment -> Bool
(==) = CategorizedAchievement -> CategorizedAchievement -> Bool
forall a. Eq a => a -> a -> Bool
(==) (CategorizedAchievement -> CategorizedAchievement -> Bool)
-> (Attainment -> CategorizedAchievement)
-> Attainment
-> Attainment
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Attainment -> CategorizedAchievement
_achievement

instance Ord Attainment where
  compare :: Attainment -> Attainment -> Ordering
compare = UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UTCTime -> UTCTime -> Ordering)
-> (Attainment -> UTCTime) -> Attainment -> Attainment -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime)
-> (Attainment -> ZonedTime) -> Attainment -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Attainment -> ZonedTime
_obtainedAt)

instance Semigroup Attainment where
  <> :: Attainment -> Attainment -> Attainment
(<>) = Attainment -> Attainment -> Attainment
forall a. Ord a => a -> a -> a
min

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

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

achievementJsonOptions :: Options
achievementJsonOptions :: Options
achievementJsonOptions =
  Options
defaultOptions
    { fieldLabelModifier = drop 1 -- drops leading underscore
    }