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
, 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")
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")