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

module Codeforces.Types.Problem where

import           Codeforces.Types.Common

import           Data.Aeson
import           Data.Text                      ( Text )

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

type ProblemTag = Text

data ProblemType = Programming | Question
    deriving Int -> ProblemType -> ShowS
[ProblemType] -> ShowS
ProblemType -> String
(Int -> ProblemType -> ShowS)
-> (ProblemType -> String)
-> ([ProblemType] -> ShowS)
-> Show ProblemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemType] -> ShowS
$cshowList :: [ProblemType] -> ShowS
show :: ProblemType -> String
$cshow :: ProblemType -> String
showsPrec :: Int -> ProblemType -> ShowS
$cshowsPrec :: Int -> ProblemType -> ShowS
Show

instance FromJSON ProblemType where
    parseJSON :: Value -> Parser ProblemType
parseJSON = String
-> (Text -> Parser ProblemType) -> Value -> Parser ProblemType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ProblemType" ((Text -> Parser ProblemType) -> Value -> Parser ProblemType)
-> (Text -> Parser ProblemType) -> Value -> Parser ProblemType
forall a b. (a -> b) -> a -> b
$ \case
        Text
"PROGRAMMING" -> ProblemType -> Parser ProblemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemType
Programming
        Text
"QUESTION"    -> ProblemType -> Parser ProblemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProblemType
Question
        Text
_             -> String -> Parser ProblemType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ProblemType"

data Problem = Problem
    { Problem -> Maybe ContestId
problemContestId :: Maybe ContestId
    -- ^ ID of /a/ contest containing the problem.
    --
    -- Note that a problem may appear in multiple contests (such as Div. 1 and
    -- Div. 2 variants of a contest), but this field only contains one.
    --
    , Problem -> Maybe Text
problemSetName   :: Maybe Text
    , Problem -> Text
problemIndex     :: ProblemIndex
    , Problem -> Text
problemName      :: Text
    , Problem -> ProblemType
problemType      :: ProblemType
    , Problem -> Maybe Points
problemPoints    :: Maybe Points
    , Problem -> Maybe Int
problemRating    :: Maybe Rating
    , Problem -> [Text]
problemTags      :: [ProblemTag]
    }
    deriving Int -> Problem -> ShowS
[Problem] -> ShowS
Problem -> String
(Int -> Problem -> ShowS)
-> (Problem -> String) -> ([Problem] -> ShowS) -> Show Problem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Problem] -> ShowS
$cshowList :: [Problem] -> ShowS
show :: Problem -> String
$cshow :: Problem -> String
showsPrec :: Int -> Problem -> ShowS
$cshowsPrec :: Int -> Problem -> ShowS
Show

instance FromJSON Problem where
    parseJSON :: Value -> Parser Problem
parseJSON = String -> (Object -> Parser Problem) -> Value -> Parser Problem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Problem" ((Object -> Parser Problem) -> Value -> Parser Problem)
-> (Object -> Parser Problem) -> Value -> Parser Problem
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe ContestId
-> Maybe Text
-> Text
-> Text
-> ProblemType
-> Maybe Points
-> Maybe Int
-> [Text]
-> Problem
Problem
            (Maybe ContestId
 -> Maybe Text
 -> Text
 -> Text
 -> ProblemType
 -> Maybe Points
 -> Maybe Int
 -> [Text]
 -> Problem)
-> Parser (Maybe ContestId)
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> ProblemType
      -> Maybe Points
      -> Maybe Int
      -> [Text]
      -> Problem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe ContestId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"contestId")
            Parser
  (Maybe Text
   -> Text
   -> Text
   -> ProblemType
   -> Maybe Points
   -> Maybe Int
   -> [Text]
   -> Problem)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> ProblemType
      -> Maybe Points
      -> Maybe Int
      -> [Text]
      -> Problem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"problemsetName")
            Parser
  (Text
   -> Text
   -> ProblemType
   -> Maybe Points
   -> Maybe Int
   -> [Text]
   -> Problem)
-> Parser Text
-> Parser
     (Text
      -> ProblemType -> Maybe Points -> Maybe Int -> [Text] -> Problem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"index")
            Parser
  (Text
   -> ProblemType -> Maybe Points -> Maybe Int -> [Text] -> Problem)
-> Parser Text
-> Parser
     (ProblemType -> Maybe Points -> Maybe Int -> [Text] -> Problem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name")
            Parser
  (ProblemType -> Maybe Points -> Maybe Int -> [Text] -> Problem)
-> Parser ProblemType
-> Parser (Maybe Points -> Maybe Int -> [Text] -> Problem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ProblemType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type")
            Parser (Maybe Points -> Maybe Int -> [Text] -> Problem)
-> Parser (Maybe Points) -> Parser (Maybe Int -> [Text] -> Problem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Points)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"points")
            Parser (Maybe Int -> [Text] -> Problem)
-> Parser (Maybe Int) -> Parser ([Text] -> Problem)
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
"rating")
            Parser ([Text] -> Problem) -> Parser [Text] -> Parser Problem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [Text]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tags")

data ProblemStats = ProblemStats
    { ProblemStats -> Maybe ContestId
pStatContestId    :: Maybe ContestId
    , ProblemStats -> Text
pStatProblemIndex :: ProblemIndex
    , ProblemStats -> Int
pStatSolvedCount  :: Int
    }
    deriving Int -> ProblemStats -> ShowS
[ProblemStats] -> ShowS
ProblemStats -> String
(Int -> ProblemStats -> ShowS)
-> (ProblemStats -> String)
-> ([ProblemStats] -> ShowS)
-> Show ProblemStats
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemStats] -> ShowS
$cshowList :: [ProblemStats] -> ShowS
show :: ProblemStats -> String
$cshow :: ProblemStats -> String
showsPrec :: Int -> ProblemStats -> ShowS
$cshowsPrec :: Int -> ProblemStats -> ShowS
Show

instance FromJSON ProblemStats where
    parseJSON :: Value -> Parser ProblemStats
parseJSON = String
-> (Object -> Parser ProblemStats) -> Value -> Parser ProblemStats
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ProblemStats" ((Object -> Parser ProblemStats) -> Value -> Parser ProblemStats)
-> (Object -> Parser ProblemStats) -> Value -> Parser ProblemStats
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe ContestId -> Text -> Int -> ProblemStats
ProblemStats
            (Maybe ContestId -> Text -> Int -> ProblemStats)
-> Parser (Maybe ContestId) -> Parser (Text -> Int -> ProblemStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser (Maybe ContestId)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"contestId")
            Parser (Text -> Int -> ProblemStats)
-> Parser Text -> Parser (Int -> ProblemStats)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"index")
            Parser (Int -> ProblemStats) -> Parser Int -> Parser ProblemStats
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
"solvedCount")

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

-- | Problem data returned by the API contains two lists: a list of problems
-- followed by a list of corresponding problem statistics.
data ProblemsResponse = ProblemsResponse
    { ProblemsResponse -> [Problem]
prProblems :: [Problem]
    , ProblemsResponse -> [ProblemStats]
prStats    :: [ProblemStats]
    }
    deriving Int -> ProblemsResponse -> ShowS
[ProblemsResponse] -> ShowS
ProblemsResponse -> String
(Int -> ProblemsResponse -> ShowS)
-> (ProblemsResponse -> String)
-> ([ProblemsResponse] -> ShowS)
-> Show ProblemsResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProblemsResponse] -> ShowS
$cshowList :: [ProblemsResponse] -> ShowS
show :: ProblemsResponse -> String
$cshow :: ProblemsResponse -> String
showsPrec :: Int -> ProblemsResponse -> ShowS
$cshowsPrec :: Int -> ProblemsResponse -> ShowS
Show

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

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