--------------------------------------------------------------------------------

module Codeforces.Types.Standings where

import           Codeforces.Types.Common
import           Codeforces.Types.Contest       ( Contest )
import           Codeforces.Types.Party         ( Party )
import           Codeforces.Types.Problem       ( Problem )

import           Data.Aeson
import           Data.Time

--------------------------------------------------------------------------------

data ResultType
    -- | Means a party's points can decrease, e.g. if their solution fails
    -- during a system test.
    = ResultPreliminary
    -- | Means a party can only increase points for this problem by submitting
    -- better solutions.
    | ResultFinal
    deriving Int -> ResultType -> ShowS
[ResultType] -> ShowS
ResultType -> String
(Int -> ResultType -> ShowS)
-> (ResultType -> String)
-> ([ResultType] -> ShowS)
-> Show ResultType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResultType] -> ShowS
$cshowList :: [ResultType] -> ShowS
show :: ResultType -> String
$cshow :: ResultType -> String
showsPrec :: Int -> ResultType -> ShowS
$cshowsPrec :: Int -> ResultType -> ShowS
Show

instance FromJSON ResultType where
    parseJSON :: Value -> Parser ResultType
parseJSON = String -> (Text -> Parser ResultType) -> Value -> Parser ResultType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ResultType" ((Text -> Parser ResultType) -> Value -> Parser ResultType)
-> (Text -> Parser ResultType) -> Value -> Parser ResultType
forall a b. (a -> b) -> a -> b
$ \case
        Text
"PRELIMINARY" -> ResultType -> Parser ResultType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultType
ResultPreliminary
        Text
"FINAL"       -> ResultType -> Parser ResultType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultType
ResultFinal
        Text
_             -> String -> Parser ResultType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ResultType"

data ProblemResult = ProblemResult
    { ProblemResult -> Points
prPoints               :: Points
    -- | Penalty (in ICPC meaning) of the party for this problem.
    , ProblemResult -> Maybe Int
prPenalty              :: Maybe Int
    , ProblemResult -> Int
prRejectedAttemptCount :: Int
    , ProblemResult -> ResultType
prType                 :: ResultType
    -- | Number of seconds after the start of the contest before the submission,
    -- that brought maximal amount of points for this problem.
    , ProblemResult -> Maybe Int
prBestSubmissionTime   :: Maybe Int
    }
    deriving Int -> ProblemResult -> ShowS
[ProblemResult] -> ShowS
ProblemResult -> String
(Int -> ProblemResult -> ShowS)
-> (ProblemResult -> String)
-> ([ProblemResult] -> ShowS)
-> Show ProblemResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemResult] -> ShowS
$cshowList :: [ProblemResult] -> ShowS
show :: ProblemResult -> String
$cshow :: ProblemResult -> String
showsPrec :: Int -> ProblemResult -> ShowS
$cshowsPrec :: Int -> ProblemResult -> ShowS
Show

-- | True if no solution has been submitted for this problem in the contest.
prNotAttempted :: ProblemResult -> Bool
prNotAttempted :: ProblemResult -> Bool
prNotAttempted ProblemResult {Points
Int
Maybe Int
ResultType
prBestSubmissionTime :: Maybe Int
prType :: ResultType
prRejectedAttemptCount :: Int
prPenalty :: Maybe Int
prPoints :: Points
prBestSubmissionTime :: ProblemResult -> Maybe Int
prType :: ProblemResult -> ResultType
prRejectedAttemptCount :: ProblemResult -> Int
prPenalty :: ProblemResult -> Maybe Int
prPoints :: ProblemResult -> Points
..} =
    Points
prPoints Points -> Points -> Bool
forall a. Eq a => a -> a -> Bool
== Points
0 Bool -> Bool -> Bool
&& Int
prRejectedAttemptCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

instance FromJSON ProblemResult where
    parseJSON :: Value -> Parser ProblemResult
parseJSON = String
-> (Object -> Parser ProblemResult)
-> Value
-> Parser ProblemResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProblemResult" ((Object -> Parser ProblemResult) -> Value -> Parser ProblemResult)
-> (Object -> Parser ProblemResult)
-> Value
-> Parser ProblemResult
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Points
-> Maybe Int -> Int -> ResultType -> Maybe Int -> ProblemResult
ProblemResult
            (Points
 -> Maybe Int -> Int -> ResultType -> Maybe Int -> ProblemResult)
-> Parser Points
-> Parser
     (Maybe Int -> Int -> ResultType -> Maybe Int -> ProblemResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Points
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"points")
            Parser
  (Maybe Int -> Int -> ResultType -> Maybe Int -> ProblemResult)
-> Parser (Maybe Int)
-> Parser (Int -> ResultType -> Maybe Int -> ProblemResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"penalty")
            Parser (Int -> ResultType -> Maybe Int -> ProblemResult)
-> Parser Int -> Parser (ResultType -> Maybe Int -> ProblemResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rejectedAttemptCount")
            Parser (ResultType -> Maybe Int -> ProblemResult)
-> Parser ResultType -> Parser (Maybe Int -> ProblemResult)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ResultType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type")
            Parser (Maybe Int -> ProblemResult)
-> Parser (Maybe Int) -> Parser ProblemResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"bestSubmissionTime")

data RanklistRow = RanklistRow
    { RanklistRow -> Party
rrParty                 :: Party
    , RanklistRow -> Int
rrRank                  :: Int
    , RanklistRow -> Points
rrPoints                :: Points
    , RanklistRow -> Int
rrPenalty               :: Int
    , RanklistRow -> Int
rrSuccessfulHackCount   :: Int
    , RanklistRow -> Int
rrUnsuccessfulHackCount :: Int
    , RanklistRow -> [ProblemResult]
rrProblemResults        :: [ProblemResult]
    -- | Time from the start of the contest to the last submission that added
    -- some points to the total score of the party. For IOI contests only.
    , RanklistRow -> Maybe DiffTime
rrLastSubmissionTime    :: Maybe DiffTime
    }
    deriving Int -> RanklistRow -> ShowS
[RanklistRow] -> ShowS
RanklistRow -> String
(Int -> RanklistRow -> ShowS)
-> (RanklistRow -> String)
-> ([RanklistRow] -> ShowS)
-> Show RanklistRow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RanklistRow] -> ShowS
$cshowList :: [RanklistRow] -> ShowS
show :: RanklistRow -> String
$cshow :: RanklistRow -> String
showsPrec :: Int -> RanklistRow -> ShowS
$cshowsPrec :: Int -> RanklistRow -> ShowS
Show

instance FromJSON RanklistRow where
    parseJSON :: Value -> Parser RanklistRow
parseJSON = String
-> (Object -> Parser RanklistRow) -> Value -> Parser RanklistRow
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RanklistRow" ((Object -> Parser RanklistRow) -> Value -> Parser RanklistRow)
-> (Object -> Parser RanklistRow) -> Value -> Parser RanklistRow
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Party
-> Int
-> Points
-> Int
-> Int
-> Int
-> [ProblemResult]
-> Maybe DiffTime
-> RanklistRow
RanklistRow
            (Party
 -> Int
 -> Points
 -> Int
 -> Int
 -> Int
 -> [ProblemResult]
 -> Maybe DiffTime
 -> RanklistRow)
-> Parser Party
-> Parser
     (Int
      -> Points
      -> Int
      -> Int
      -> Int
      -> [ProblemResult]
      -> Maybe DiffTime
      -> RanklistRow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Party
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"party")
            Parser
  (Int
   -> Points
   -> Int
   -> Int
   -> Int
   -> [ProblemResult]
   -> Maybe DiffTime
   -> RanklistRow)
-> Parser Int
-> Parser
     (Points
      -> Int
      -> Int
      -> Int
      -> [ProblemResult]
      -> Maybe DiffTime
      -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rank")
            Parser
  (Points
   -> Int
   -> Int
   -> Int
   -> [ProblemResult]
   -> Maybe DiffTime
   -> RanklistRow)
-> Parser Points
-> Parser
     (Int
      -> Int -> Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Points
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"points")
            Parser
  (Int
   -> Int -> Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
-> Parser Int
-> Parser
     (Int -> Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"penalty")
            Parser
  (Int -> Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
-> Parser Int
-> Parser (Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"successfulHackCount")
            Parser (Int -> [ProblemResult] -> Maybe DiffTime -> RanklistRow)
-> Parser Int
-> Parser ([ProblemResult] -> Maybe DiffTime -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"unsuccessfulHackCount")
            Parser ([ProblemResult] -> Maybe DiffTime -> RanklistRow)
-> Parser [ProblemResult] -> Parser (Maybe DiffTime -> RanklistRow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [ProblemResult]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"problemResults")
            Parser (Maybe DiffTime -> RanklistRow)
-> Parser (Maybe DiffTime) -> Parser RanklistRow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Integer -> DiffTime) -> Maybe Integer -> Maybe DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> DiffTime
secondsToDiffTime (Maybe Integer -> Maybe DiffTime)
-> Parser (Maybe Integer) -> Parser (Maybe DiffTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"lastSubmissionTimeSeconds")

--------------------------------------------------------------------------------

-- | The standings returned by the API consists of 'Contest' details, the list
-- of 'Problem's and the requested portion of the standings list (a list of
-- 'RanklistRow's).
data Standings = Standings
    { Standings -> Contest
standingsContest  :: Contest
    , Standings -> [Problem]
standingsProblems :: [Problem]
    , Standings -> [RanklistRow]
standingsRanklist :: [RanklistRow]
    }
    deriving Int -> Standings -> ShowS
[Standings] -> ShowS
Standings -> String
(Int -> Standings -> ShowS)
-> (Standings -> String)
-> ([Standings] -> ShowS)
-> Show Standings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Standings] -> ShowS
$cshowList :: [Standings] -> ShowS
show :: Standings -> String
$cshow :: Standings -> String
showsPrec :: Int -> Standings -> ShowS
$cshowsPrec :: Int -> Standings -> ShowS
Show

instance FromJSON Standings where
    parseJSON :: Value -> Parser Standings
parseJSON =
        String -> (Object -> Parser Standings) -> Value -> Parser Standings
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Standings"
            ((Object -> Parser Standings) -> Value -> Parser Standings)
-> (Object -> Parser Standings) -> Value -> Parser Standings
forall a b. (a -> b) -> a -> b
$ \Object
v ->
                  Contest -> [Problem] -> [RanklistRow] -> Standings
Standings
                      (Contest -> [Problem] -> [RanklistRow] -> Standings)
-> Parser Contest
-> Parser ([Problem] -> [RanklistRow] -> Standings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Contest
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contest")
                      Parser ([Problem] -> [RanklistRow] -> Standings)
-> Parser [Problem] -> Parser ([RanklistRow] -> Standings)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [Problem]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"problems")
                      Parser ([RanklistRow] -> Standings)
-> Parser [RanklistRow] -> Parser Standings
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [RanklistRow]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"rows")

--------------------------------------------------------------------------------