module Codeforces.Types.Contest where
import Codeforces.Types.Common
import Data.Aeson
import Data.Text ( Text )
import Data.Time
import Data.Time.Clock.POSIX
data ScoringType = ScoringCF | ScoringIOI | ScoringICPC
deriving (Int -> ScoringType -> ShowS
[ScoringType] -> ShowS
ScoringType -> String
(Int -> ScoringType -> ShowS)
-> (ScoringType -> String)
-> ([ScoringType] -> ShowS)
-> Show ScoringType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScoringType] -> ShowS
$cshowList :: [ScoringType] -> ShowS
show :: ScoringType -> String
$cshow :: ScoringType -> String
showsPrec :: Int -> ScoringType -> ShowS
$cshowsPrec :: Int -> ScoringType -> ShowS
Show, ScoringType -> ScoringType -> Bool
(ScoringType -> ScoringType -> Bool)
-> (ScoringType -> ScoringType -> Bool) -> Eq ScoringType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScoringType -> ScoringType -> Bool
$c/= :: ScoringType -> ScoringType -> Bool
== :: ScoringType -> ScoringType -> Bool
$c== :: ScoringType -> ScoringType -> Bool
Eq)
instance FromJSON ScoringType where
parseJSON :: Value -> Parser ScoringType
parseJSON = String
-> (Text -> Parser ScoringType) -> Value -> Parser ScoringType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ScoringType" ((Text -> Parser ScoringType) -> Value -> Parser ScoringType)
-> (Text -> Parser ScoringType) -> Value -> Parser ScoringType
forall a b. (a -> b) -> a -> b
$ \case
Text
"CF" -> ScoringType -> Parser ScoringType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoringType
ScoringCF
Text
"IOI" -> ScoringType -> Parser ScoringType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoringType
ScoringIOI
Text
"ICPC" -> ScoringType -> Parser ScoringType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScoringType
ScoringICPC
Text
_ -> String -> Parser ScoringType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Scoring Type"
data ContestPhase = Before | Coding | PendingSystemTest | Finished
deriving Int -> ContestPhase -> ShowS
[ContestPhase] -> ShowS
ContestPhase -> String
(Int -> ContestPhase -> ShowS)
-> (ContestPhase -> String)
-> ([ContestPhase] -> ShowS)
-> Show ContestPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContestPhase] -> ShowS
$cshowList :: [ContestPhase] -> ShowS
show :: ContestPhase -> String
$cshow :: ContestPhase -> String
showsPrec :: Int -> ContestPhase -> ShowS
$cshowsPrec :: Int -> ContestPhase -> ShowS
Show
instance FromJSON ContestPhase where
parseJSON :: Value -> Parser ContestPhase
parseJSON = String
-> (Text -> Parser ContestPhase) -> Value -> Parser ContestPhase
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContestPhase" ((Text -> Parser ContestPhase) -> Value -> Parser ContestPhase)
-> (Text -> Parser ContestPhase) -> Value -> Parser ContestPhase
forall a b. (a -> b) -> a -> b
$ \case
Text
"BEFORE" -> ContestPhase -> Parser ContestPhase
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContestPhase
Before
Text
"CODING" -> ContestPhase -> Parser ContestPhase
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContestPhase
Before
Text
"PENDING_SYSTEM_TEST" -> ContestPhase -> Parser ContestPhase
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContestPhase
PendingSystemTest
Text
"FINISHED" -> ContestPhase -> Parser ContestPhase
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContestPhase
Finished
Text
_ -> String -> Parser ContestPhase
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid Contest Phase"
data Contest = Contest
{ Contest -> ContestId
contestId :: ContestId
, Contest -> Text
contestName :: Text
, Contest -> ScoringType
contestType :: ScoringType
, Contest -> ContestPhase
contestPhase :: ContestPhase
, Contest -> Bool
contestFrozen :: Bool
, Contest -> DiffTime
contestDuration :: DiffTime
, Contest -> Maybe UTCTime
contestStartTime :: Maybe UTCTime
}
deriving Int -> Contest -> ShowS
[Contest] -> ShowS
Contest -> String
(Int -> Contest -> ShowS)
-> (Contest -> String) -> ([Contest] -> ShowS) -> Show Contest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contest] -> ShowS
$cshowList :: [Contest] -> ShowS
show :: Contest -> String
$cshow :: Contest -> String
showsPrec :: Int -> Contest -> ShowS
$cshowsPrec :: Int -> Contest -> ShowS
Show
instance FromJSON Contest where
parseJSON :: Value -> Parser Contest
parseJSON = String -> (Object -> Parser Contest) -> Value -> Parser Contest
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Contest" ((Object -> Parser Contest) -> Value -> Parser Contest)
-> (Object -> Parser Contest) -> Value -> Parser Contest
forall a b. (a -> b) -> a -> b
$ \Object
v ->
let durationSeconds :: Parser Integer
durationSeconds = (Object
v Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"durationSeconds")
startTimePosix :: Parser (Maybe POSIXTime)
startTimePosix = (Object
v Object -> Text -> Parser (Maybe POSIXTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"startTimeSeconds")
in ContestId
-> Text
-> ScoringType
-> ContestPhase
-> Bool
-> DiffTime
-> Maybe UTCTime
-> Contest
Contest
(ContestId
-> Text
-> ScoringType
-> ContestPhase
-> Bool
-> DiffTime
-> Maybe UTCTime
-> Contest)
-> Parser ContestId
-> Parser
(Text
-> ScoringType
-> ContestPhase
-> Bool
-> DiffTime
-> Maybe UTCTime
-> Contest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser ContestId
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id")
Parser
(Text
-> ScoringType
-> ContestPhase
-> Bool
-> DiffTime
-> Maybe UTCTime
-> Contest)
-> Parser Text
-> Parser
(ScoringType
-> ContestPhase -> Bool -> DiffTime -> Maybe UTCTime -> Contest)
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
(ScoringType
-> ContestPhase -> Bool -> DiffTime -> Maybe UTCTime -> Contest)
-> Parser ScoringType
-> Parser
(ContestPhase -> Bool -> DiffTime -> Maybe UTCTime -> Contest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ScoringType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type")
Parser
(ContestPhase -> Bool -> DiffTime -> Maybe UTCTime -> Contest)
-> Parser ContestPhase
-> Parser (Bool -> DiffTime -> Maybe UTCTime -> Contest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ContestPhase
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"phase")
Parser (Bool -> DiffTime -> Maybe UTCTime -> Contest)
-> Parser Bool -> Parser (DiffTime -> Maybe UTCTime -> Contest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"frozen")
Parser (DiffTime -> Maybe UTCTime -> Contest)
-> Parser DiffTime -> Parser (Maybe UTCTime -> Contest)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Parser Integer -> Parser DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer
durationSeconds)
Parser (Maybe UTCTime -> Contest)
-> Parser (Maybe UTCTime) -> Parser Contest
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((POSIXTime -> UTCTime) -> Maybe POSIXTime -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap POSIXTime -> UTCTime
posixSecondsToUTCTime (Maybe POSIXTime -> Maybe UTCTime)
-> Parser (Maybe POSIXTime) -> Parser (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe POSIXTime)
startTimePosix)