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

-- | Common types used across the application.
--
module Codeforces.Types.Common where

import           Data.Aeson
import           Data.Text                      ( Text )

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

-- | ID of the contest.
--
-- Not to be confused with contest round number. The ID appears in the contest
-- URL, for example in: <https://codeforces.com/contest/566/status>.
--
newtype ContestId = ContestId { ContestId -> Int
unContestId :: Int }
    deriving (ContestId -> ContestId -> Bool
(ContestId -> ContestId -> Bool)
-> (ContestId -> ContestId -> Bool) -> Eq ContestId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContestId -> ContestId -> Bool
$c/= :: ContestId -> ContestId -> Bool
== :: ContestId -> ContestId -> Bool
$c== :: ContestId -> ContestId -> Bool
Eq, Eq ContestId
Eq ContestId
-> (ContestId -> ContestId -> Ordering)
-> (ContestId -> ContestId -> Bool)
-> (ContestId -> ContestId -> Bool)
-> (ContestId -> ContestId -> Bool)
-> (ContestId -> ContestId -> Bool)
-> (ContestId -> ContestId -> ContestId)
-> (ContestId -> ContestId -> ContestId)
-> Ord ContestId
ContestId -> ContestId -> Bool
ContestId -> ContestId -> Ordering
ContestId -> ContestId -> ContestId
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 :: ContestId -> ContestId -> ContestId
$cmin :: ContestId -> ContestId -> ContestId
max :: ContestId -> ContestId -> ContestId
$cmax :: ContestId -> ContestId -> ContestId
>= :: ContestId -> ContestId -> Bool
$c>= :: ContestId -> ContestId -> Bool
> :: ContestId -> ContestId -> Bool
$c> :: ContestId -> ContestId -> Bool
<= :: ContestId -> ContestId -> Bool
$c<= :: ContestId -> ContestId -> Bool
< :: ContestId -> ContestId -> Bool
$c< :: ContestId -> ContestId -> Bool
compare :: ContestId -> ContestId -> Ordering
$ccompare :: ContestId -> ContestId -> Ordering
$cp1Ord :: Eq ContestId
Ord, Int -> ContestId -> ShowS
[ContestId] -> ShowS
ContestId -> String
(Int -> ContestId -> ShowS)
-> (ContestId -> String)
-> ([ContestId] -> ShowS)
-> Show ContestId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContestId] -> ShowS
$cshowList :: [ContestId] -> ShowS
show :: ContestId -> String
$cshow :: ContestId -> String
showsPrec :: Int -> ContestId -> ShowS
$cshowsPrec :: Int -> ContestId -> ShowS
Show)

instance FromJSON ContestId where
    parseJSON :: Value -> Parser ContestId
parseJSON Value
v = Int -> ContestId
ContestId (Int -> ContestId) -> Parser Int -> Parser ContestId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- | Codeforces user handle.
newtype Handle = Handle { Handle -> Text
unHandle :: Text }
    deriving (Handle -> Handle -> Bool
(Handle -> Handle -> Bool)
-> (Handle -> Handle -> Bool) -> Eq Handle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Handle -> Handle -> Bool
$c/= :: Handle -> Handle -> Bool
== :: Handle -> Handle -> Bool
$c== :: Handle -> Handle -> Bool
Eq, Eq Handle
Eq Handle
-> (Handle -> Handle -> Ordering)
-> (Handle -> Handle -> Bool)
-> (Handle -> Handle -> Bool)
-> (Handle -> Handle -> Bool)
-> (Handle -> Handle -> Bool)
-> (Handle -> Handle -> Handle)
-> (Handle -> Handle -> Handle)
-> Ord Handle
Handle -> Handle -> Bool
Handle -> Handle -> Ordering
Handle -> Handle -> Handle
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 :: Handle -> Handle -> Handle
$cmin :: Handle -> Handle -> Handle
max :: Handle -> Handle -> Handle
$cmax :: Handle -> Handle -> Handle
>= :: Handle -> Handle -> Bool
$c>= :: Handle -> Handle -> Bool
> :: Handle -> Handle -> Bool
$c> :: Handle -> Handle -> Bool
<= :: Handle -> Handle -> Bool
$c<= :: Handle -> Handle -> Bool
< :: Handle -> Handle -> Bool
$c< :: Handle -> Handle -> Bool
compare :: Handle -> Handle -> Ordering
$ccompare :: Handle -> Handle -> Ordering
$cp1Ord :: Eq Handle
Ord, Int -> Handle -> ShowS
[Handle] -> ShowS
Handle -> String
(Int -> Handle -> ShowS)
-> (Handle -> String) -> ([Handle] -> ShowS) -> Show Handle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Handle] -> ShowS
$cshowList :: [Handle] -> ShowS
show :: Handle -> String
$cshow :: Handle -> String
showsPrec :: Int -> Handle -> ShowS
$cshowsPrec :: Int -> Handle -> ShowS
Show)

instance FromJSON Handle where
    parseJSON :: Value -> Parser Handle
parseJSON Value
v = Text -> Handle
Handle (Text -> Handle) -> Parser Text -> Parser Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance ToJSON Handle where
    toJSON :: Handle -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Handle -> Text) -> Handle -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text
unHandle

-- | Number of points gained for a submission or across a contest.
type Points = Float

-- | A letter, or letter with digit(s) indicating the problem index in a
-- contest.
type ProblemIndex = Text

-- | User or problem rating.
type Rating = Int

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