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

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)

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