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

module Codeforces.Types.Party where

import           Codeforces.Types.Common

import           Data.Aeson
import           Data.Text                      ( Text )
import           Data.Time.Clock
import           Data.Time.Clock.POSIX          ( posixSecondsToUTCTime )

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

-- | Member of a party.
data Member = Member
    { Member -> Handle
memberHandle :: Handle
    }
    deriving (Member -> Member -> Bool
(Member -> Member -> Bool)
-> (Member -> Member -> Bool) -> Eq Member
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Member -> Member -> Bool
$c/= :: Member -> Member -> Bool
== :: Member -> Member -> Bool
$c== :: Member -> Member -> Bool
Eq, Eq Member
Eq Member
-> (Member -> Member -> Ordering)
-> (Member -> Member -> Bool)
-> (Member -> Member -> Bool)
-> (Member -> Member -> Bool)
-> (Member -> Member -> Bool)
-> (Member -> Member -> Member)
-> (Member -> Member -> Member)
-> Ord Member
Member -> Member -> Bool
Member -> Member -> Ordering
Member -> Member -> Member
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Member -> Member -> Member
$cmin :: Member -> Member -> Member
max :: Member -> Member -> Member
$cmax :: Member -> Member -> Member
>= :: Member -> Member -> Bool
$c>= :: Member -> Member -> Bool
> :: Member -> Member -> Bool
$c> :: Member -> Member -> Bool
<= :: Member -> Member -> Bool
$c<= :: Member -> Member -> Bool
< :: Member -> Member -> Bool
$c< :: Member -> Member -> Bool
compare :: Member -> Member -> Ordering
$ccompare :: Member -> Member -> Ordering
$cp1Ord :: Eq Member
Ord, Int -> Member -> ShowS
[Member] -> ShowS
Member -> String
(Int -> Member -> ShowS)
-> (Member -> String) -> ([Member] -> ShowS) -> Show Member
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Member] -> ShowS
$cshowList :: [Member] -> ShowS
show :: Member -> String
$cshow :: Member -> String
showsPrec :: Int -> Member -> ShowS
$cshowsPrec :: Int -> Member -> ShowS
Show)

instance FromJSON Member where
    parseJSON :: Value -> Parser Member
parseJSON = String -> (Object -> Parser Member) -> Value -> Parser Member
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Member" ((Object -> Parser Member) -> Value -> Parser Member)
-> (Object -> Parser Member) -> Value -> Parser Member
forall a b. (a -> b) -> a -> b
$ \Object
v -> Handle -> Member
Member (Handle -> Member) -> Parser Handle -> Parser Member
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Handle
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"handle")

data ParticipantType
    = Contestant
    | Practice
    | Virtual
    | Manager
    | OutOfCompetition
    deriving (ParticipantType -> ParticipantType -> Bool
(ParticipantType -> ParticipantType -> Bool)
-> (ParticipantType -> ParticipantType -> Bool)
-> Eq ParticipantType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParticipantType -> ParticipantType -> Bool
$c/= :: ParticipantType -> ParticipantType -> Bool
== :: ParticipantType -> ParticipantType -> Bool
$c== :: ParticipantType -> ParticipantType -> Bool
Eq, Eq ParticipantType
Eq ParticipantType
-> (ParticipantType -> ParticipantType -> Ordering)
-> (ParticipantType -> ParticipantType -> Bool)
-> (ParticipantType -> ParticipantType -> Bool)
-> (ParticipantType -> ParticipantType -> Bool)
-> (ParticipantType -> ParticipantType -> Bool)
-> (ParticipantType -> ParticipantType -> ParticipantType)
-> (ParticipantType -> ParticipantType -> ParticipantType)
-> Ord ParticipantType
ParticipantType -> ParticipantType -> Bool
ParticipantType -> ParticipantType -> Ordering
ParticipantType -> ParticipantType -> ParticipantType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ParticipantType -> ParticipantType -> ParticipantType
$cmin :: ParticipantType -> ParticipantType -> ParticipantType
max :: ParticipantType -> ParticipantType -> ParticipantType
$cmax :: ParticipantType -> ParticipantType -> ParticipantType
>= :: ParticipantType -> ParticipantType -> Bool
$c>= :: ParticipantType -> ParticipantType -> Bool
> :: ParticipantType -> ParticipantType -> Bool
$c> :: ParticipantType -> ParticipantType -> Bool
<= :: ParticipantType -> ParticipantType -> Bool
$c<= :: ParticipantType -> ParticipantType -> Bool
< :: ParticipantType -> ParticipantType -> Bool
$c< :: ParticipantType -> ParticipantType -> Bool
compare :: ParticipantType -> ParticipantType -> Ordering
$ccompare :: ParticipantType -> ParticipantType -> Ordering
$cp1Ord :: Eq ParticipantType
Ord, Int -> ParticipantType -> ShowS
[ParticipantType] -> ShowS
ParticipantType -> String
(Int -> ParticipantType -> ShowS)
-> (ParticipantType -> String)
-> ([ParticipantType] -> ShowS)
-> Show ParticipantType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParticipantType] -> ShowS
$cshowList :: [ParticipantType] -> ShowS
show :: ParticipantType -> String
$cshow :: ParticipantType -> String
showsPrec :: Int -> ParticipantType -> ShowS
$cshowsPrec :: Int -> ParticipantType -> ShowS
Show)

instance FromJSON ParticipantType where
    parseJSON :: Value -> Parser ParticipantType
parseJSON = String
-> (Text -> Parser ParticipantType)
-> Value
-> Parser ParticipantType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ParticipantType" ((Text -> Parser ParticipantType)
 -> Value -> Parser ParticipantType)
-> (Text -> Parser ParticipantType)
-> Value
-> Parser ParticipantType
forall a b. (a -> b) -> a -> b
$ \case
        Text
"CONTESTANT"         -> ParticipantType -> Parser ParticipantType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParticipantType
Contestant
        Text
"PRACTICE"           -> ParticipantType -> Parser ParticipantType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParticipantType
Practice
        Text
"VIRTUAL"            -> ParticipantType -> Parser ParticipantType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParticipantType
Virtual
        Text
"MANAGER"            -> ParticipantType -> Parser ParticipantType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParticipantType
Manager
        Text
"OUT_OF_COMPETITION" -> ParticipantType -> Parser ParticipantType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ParticipantType
OutOfCompetition
        Text
_                    -> String -> Parser ParticipantType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ParticipantType"

-- | Represents a party, participating in a contest.
data Party = Party
    { Party -> Maybe ContestId
partyContestId       :: Maybe ContestId
    , Party -> [Member]
partyMembers         :: [Member]
    , Party -> ParticipantType
partyParticipantType :: ParticipantType
    , Party -> Maybe Int
partyTeamId          :: Maybe Int
    , Party -> Maybe Text
partyTeamName        :: Maybe Text
    , Party -> Bool
partyIsGhost         :: Bool
    , Party -> Maybe Int
partyRoom            :: Maybe Int
    , Party -> Maybe UTCTime
partyStartTime       :: Maybe UTCTime
    }
    deriving (Party -> Party -> Bool
(Party -> Party -> Bool) -> (Party -> Party -> Bool) -> Eq Party
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Party -> Party -> Bool
$c/= :: Party -> Party -> Bool
== :: Party -> Party -> Bool
$c== :: Party -> Party -> Bool
Eq, Eq Party
Eq Party
-> (Party -> Party -> Ordering)
-> (Party -> Party -> Bool)
-> (Party -> Party -> Bool)
-> (Party -> Party -> Bool)
-> (Party -> Party -> Bool)
-> (Party -> Party -> Party)
-> (Party -> Party -> Party)
-> Ord Party
Party -> Party -> Bool
Party -> Party -> Ordering
Party -> Party -> Party
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Party -> Party -> Party
$cmin :: Party -> Party -> Party
max :: Party -> Party -> Party
$cmax :: Party -> Party -> Party
>= :: Party -> Party -> Bool
$c>= :: Party -> Party -> Bool
> :: Party -> Party -> Bool
$c> :: Party -> Party -> Bool
<= :: Party -> Party -> Bool
$c<= :: Party -> Party -> Bool
< :: Party -> Party -> Bool
$c< :: Party -> Party -> Bool
compare :: Party -> Party -> Ordering
$ccompare :: Party -> Party -> Ordering
$cp1Ord :: Eq Party
Ord, Int -> Party -> ShowS
[Party] -> ShowS
Party -> String
(Int -> Party -> ShowS)
-> (Party -> String) -> ([Party] -> ShowS) -> Show Party
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Party] -> ShowS
$cshowList :: [Party] -> ShowS
show :: Party -> String
$cshow :: Party -> String
showsPrec :: Int -> Party -> ShowS
$cshowsPrec :: Int -> Party -> ShowS
Show)

instance FromJSON Party where
    parseJSON :: Value -> Parser Party
parseJSON = String -> (Object -> Parser Party) -> Value -> Parser Party
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Party" ((Object -> Parser Party) -> Value -> Parser Party)
-> (Object -> Parser Party) -> Value -> Parser Party
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe ContestId
-> [Member]
-> ParticipantType
-> Maybe Int
-> Maybe Text
-> Bool
-> Maybe Int
-> Maybe UTCTime
-> Party
Party
            (Maybe ContestId
 -> [Member]
 -> ParticipantType
 -> Maybe Int
 -> Maybe Text
 -> Bool
 -> Maybe Int
 -> Maybe UTCTime
 -> Party)
-> Parser (Maybe ContestId)
-> Parser
     ([Member]
      -> ParticipantType
      -> Maybe Int
      -> Maybe Text
      -> Bool
      -> Maybe Int
      -> Maybe UTCTime
      -> Party)
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
  ([Member]
   -> ParticipantType
   -> Maybe Int
   -> Maybe Text
   -> Bool
   -> Maybe Int
   -> Maybe UTCTime
   -> Party)
-> Parser [Member]
-> Parser
     (ParticipantType
      -> Maybe Int
      -> Maybe Text
      -> Bool
      -> Maybe Int
      -> Maybe UTCTime
      -> Party)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser [Member]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"members")
            Parser
  (ParticipantType
   -> Maybe Int
   -> Maybe Text
   -> Bool
   -> Maybe Int
   -> Maybe UTCTime
   -> Party)
-> Parser ParticipantType
-> Parser
     (Maybe Int
      -> Maybe Text -> Bool -> Maybe Int -> Maybe UTCTime -> Party)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser ParticipantType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"participantType")
            Parser
  (Maybe Int
   -> Maybe Text -> Bool -> Maybe Int -> Maybe UTCTime -> Party)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text -> Bool -> Maybe Int -> Maybe UTCTime -> Party)
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
"teamId")
            Parser (Maybe Text -> Bool -> Maybe Int -> Maybe UTCTime -> Party)
-> Parser (Maybe Text)
-> Parser (Bool -> Maybe Int -> Maybe UTCTime -> Party)
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
"teamName")
            Parser (Bool -> Maybe Int -> Maybe UTCTime -> Party)
-> Parser Bool -> Parser (Maybe Int -> Maybe UTCTime -> Party)
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
"ghost")
            Parser (Maybe Int -> Maybe UTCTime -> Party)
-> Parser (Maybe Int) -> Parser (Maybe UTCTime -> Party)
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
"room")
            Parser (Maybe UTCTime -> Party)
-> Parser (Maybe UTCTime) -> Parser Party
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
<$> Object
v Object -> Text -> Parser (Maybe POSIXTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"startTimeSeconds")

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