{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeOperators #-}
module RatingChgkInfo.Types
(
RatingClient
, Items(..)
, SeasonMap(..)
, RatingApi
, Player(..)
, PlayerTeam(..)
, PlayerSeason(..)
, PlayerTournament(..)
, PlayerRating(..)
, Team(..)
, TeamBaseRecap(..)
, TeamTournament(..)
, TeamRating(..)
, TournamentShort(..)
, Tournament(..)
, tournamentToShort
, RecapTeam(..)
, RecapPlayer(..)
, TournamentResult(..)
, TourResult(..)
, Controversial (..)
, Appeal (..)
, RatingFormula(..)
, TournamentType(..)
, ClaimStatus (..)
, AppealType (..)
, PlayerId
, TeamId
, TournamentId
, Request(..)
, TeamName(..)
, Town (..)
, SynchTown(..)
) where
import RatingChgkInfo.Types.Unsafe
import Control.Lens hiding (Wrapped, Unwrapped)
import Data.Aeson
import Data.List (lookup)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Swagger (SchemaOptions, declareNamedSchema, genericDeclareNamedSchema, schema, title, description, ToSchema)
import qualified Data.Swagger as Swagger
import qualified Data.Text as T
import Data.Time
import Servant.API
import Servant.Client (ClientM)
import Text.Read (read)
type RatingClient = ClientM
data Items a = Items
{ total :: Int
, items :: [a]
} deriving (Eq,Show,Read,Generic)
instance FromJSON a => FromJSON (Items a) where
parseJSON = withObject "Items list" $ \v ->
Items <$> (read <$> v .: "total_items") <*> v .: "items"
newtype SeasonMap a = SeasonMap { unSeasonMap :: Map Int a } deriving (Eq,Show,Read,Generic)
instance FromJSON a => FromJSON (SeasonMap a) where
parseJSON (Array []) = pure $ SeasonMap M.empty
parseJSON v = SeasonMap <$> parseJSON v
data Player = Player
{ idplayer :: PlayerId
, surname :: Text
, name :: Text
, patronymic :: Text
, db_chgk_info_tag :: Maybe Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON Player
instance ToJSON Player
data PlayerTeam = PlayerTeam
{ pt_idplayer :: PlayerId
, pt_idteam :: TeamId
, pt_idseason :: Text
, pt_is_captain :: Text
, pt_added_since :: Day
} deriving (Eq,Show,Read,Generic)
instance FromJSON PlayerTeam where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON PlayerTeam where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data PlayerSeason = PlayerSeason
{ ps_idplayer :: PlayerId
, ps_idseason :: Text
, ps_tournaments :: [PlayerTournament]
} deriving (Eq,Show,Read,Generic)
instance FromJSON PlayerSeason where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON PlayerSeason where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data PlayerTournament = PlayerTournament
{ ptr_idtournament :: TournamentId
, ptr_idteam :: TeamId
, ptr_in_base_team :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON PlayerTournament where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON PlayerTournament where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
data PlayerRating = PlayerRating
{ prat_idplayer :: PlayerId
, prat_idrelease :: Text
, prat_rating :: Text
, prat_rating_position :: Text
, prat_date :: Day
, prat_tournaments_in_year :: Text
, prat_tournament_count_total :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON PlayerRating where
parseJSON = genericParseJSON $ jsonOpts '_' 5
instance ToJSON PlayerRating where
toJSON = genericToJSON $ jsonOpts '_' 5
toEncoding = genericToEncoding $ jsonOpts '_' 5
data Team = Team
{ tm_idteam :: TeamId
, tm_name :: Text
, tm_town :: Text
, tm_region_name :: Text
, tm_country_name :: Text
, tm_tournaments_this_season :: Text
, tm_tournaments_total :: Text
, tm_comment :: Maybe Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON Team where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON Team where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data TeamBaseRecap = TeamBaseRecap
{ tbr_idteam :: TeamId
, tbr_idseason :: Text
, tbr_players :: [Text]
, tbr_captain :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON TeamBaseRecap where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON TeamBaseRecap where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
data TeamTournament = TeamTournament
{ tt_idteam :: TeamId
, tt_idseason :: Text
, tt_tournaments :: [Text]
} deriving (Eq,Show,Read,Generic)
instance FromJSON TeamTournament where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON TeamTournament where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data RatingFormula
= FormulaA
| FormulaB
deriving (Eq,Show,Read,Generic)
instance FromJSON RatingFormula where
parseJSON = withText "Formula should be String" $ \case
"a" -> pure FormulaA
"b" -> pure FormulaB
_ -> fail "Only two formula: a & b"
instance ToJSON RatingFormula where
toJSON FormulaA = toJSON ("a" :: Text)
toJSON FormulaB = toJSON ("b" :: Text)
toEncoding FormulaA = toEncoding ("a" :: Text)
toEncoding FormulaB = toEncoding ("b" :: Text)
data TeamRating = TeamRating
{ rat_idteam :: TeamId
, rat_idrelease :: Text
, rat_rating :: Text
, rat_rating_position :: Text
, rat_date :: Text
, rat_formula :: RatingFormula
} deriving (Eq,Show,Read,Generic)
instance FromJSON TeamRating where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON TeamRating where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
data TournamentType
= Synchronous
| StrictlySynchronous
| Asynchronous
| Casual
| Regional
| Marathon
| TotalScore
| TypeUnknown
| TypeEmpty
deriving (Eq,Show,Read,Generic)
tournamentTypes :: [(Text, TournamentType)]
tournamentTypes =
[ ("Синхрон" , Synchronous)
, ("Строго синхронный", StrictlySynchronous)
, ("Асинхрон" , Asynchronous)
, ("Обычный" , Casual)
, ("Региональный" , Regional)
, ("Марафон" , Marathon)
, ("Общий зачёт" , TotalScore)
, ("Неизвестный" , TypeUnknown)
, ("" , TypeEmpty)
]
tournamentTypenames :: [(TournamentType, Text)]
tournamentTypenames = map swap tournamentTypes
instance FromJSON TournamentType where
parseJSON = withText "TournamentType should be String" $ \t -> case lookup t tournamentTypes of
Nothing -> fail $ "Wrong TournamentType: " ++ T.unpack t
Just tt -> pure tt
instance ToJSON TournamentType where
toJSON tt = toJSON $ fromMaybe (error "Not all tournamentTypes have names") $ lookup tt tournamentTypenames
toEncoding tt = toEncoding $ fromMaybe (error "Not all tournamentTypes have names") $ lookup tt tournamentTypenames
instance ToHttpApiData TournamentType where
toUrlPiece tt = toUrlPiece $ fromMaybe (error "Not all tournamentTypes have names") $ lookup tt tournamentTypenames
toQueryParam tt = toQueryParam $ fromMaybe (error "Not all tournamentTypes have names") $ lookup tt tournamentTypenames
data TournamentShort = TournamentShort
{ trs_idtournament :: TournamentId
, trs_name :: Text
, trs_dateStart :: LocalTime
, trs_dateEnd :: LocalTime
, trs_typeName :: TournamentType
, trs_archive :: Text
, trs_dateArchivedAt :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON TournamentShort where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON TournamentShort where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
data Tournament = Tournament
{ trn_idtournament :: TournamentId
, trn_name :: Text
, trn_town :: Text
, trn_longName :: Text
, trn_dateStart :: LocalTime
, trn_dateEnd :: LocalTime
, trn_tournamentInRating :: Text
, trn_tourCount :: Text
, trn_tourQuestions :: Text
, trn_tourQuestPerTour :: Maybe Text
, trn_questionsTotal :: Text
, trn_typeName :: TournamentType
, trn_mainPaymentValue :: Text
, trn_mainPaymentCurrency :: Text
, trn_discountedPaymentValue :: Text
, trn_discountedPaymentCurrency :: Text
, trn_discountedPaymentReason :: Text
, trn_dateRequestsAllowedTo :: Text
, trn_comment :: Text
, trn_siteUrl :: Text
, trn_archive :: Text
, trn_dateArchivedAt :: Text
, trn_db_tags :: [Text]
} deriving (Eq,Show,Read,Generic)
instance FromJSON Tournament where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON Tournament where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
tournamentToShort :: Tournament -> TournamentShort
tournamentToShort Tournament{ trn_idtournament = idtournament
, trn_name = name
, trn_dateStart = dateStart
, trn_dateEnd = dateEnd
, trn_typeName = typeName
, trn_archive = archive
, trn_dateArchivedAt = dateArchived
}
= TournamentShort { trs_idtournament = idtournament
, trs_name = name
, trs_dateStart = dateStart
, trs_dateEnd = dateEnd
, trs_typeName = typeName
, trs_archive = archive
, trs_dateArchivedAt = dateArchived
}
data TournamentResult = TournamentResult
{ tr_idteam :: TeamId
, tr_current_name :: Text
, tr_base_name :: Text
, tr_position :: Text
, tr_questions_total :: Text
, tr_mask :: Text
, tr_tech_rating :: Text
, tr_tech_rating_rb :: Text
, tr_tech_rating_rt :: Text
, tr_tech_rating_r :: Text
, tr_tech_rating_rg :: Text
, tr_predicted_position :: Text
, tr_bonus_a :: Text
, tr_bonus_b :: Text
, tr_diff_bonus :: Text
, tr_included_in_rating :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON TournamentResult where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON TournamentResult where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data RecapPlayer = RecapPlayer
{ rp_idplayer :: PlayerId
, rp_is_captain :: Text
, rp_is_base :: Text
, rp_is_foreign :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON RecapPlayer where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON RecapPlayer where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data RecapTeam = RecapTeam
{ rt_idteam :: TeamId
, rt_recaps :: [RecapPlayer]
} deriving (Eq,Show,Read,Generic)
instance FromJSON RecapTeam where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON RecapTeam where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data TourResult = TourResult
{ tor_tour :: Text
, tor_mask :: [Text]
} deriving (Eq,Show,Read,Generic)
instance FromJSON TourResult where
parseJSON = genericParseJSON $ jsonOpts '_' 4
instance ToJSON TourResult where
toJSON = genericToJSON $ jsonOpts '_' 4
toEncoding = genericToEncoding $ jsonOpts '_' 4
data ClaimStatus
= ClaimNew
| ClaimAccepted
| ClaimRejected
deriving (Eq,Show,Read,Generic)
claimTypeText :: [(ClaimStatus, Text)]
claimTypeText =
[ (ClaimNew, "N")
, (ClaimAccepted, "A")
, (ClaimRejected, "D")
]
claimTextType :: [(Text, ClaimStatus)]
claimTextType = map swap claimTypeText
instance FromJSON ClaimStatus where
parseJSON = withText "ClaimStatus should be String" $ \t -> case lookup t claimTextType of
Nothing -> fail $ "Wrong ClaimStatus " ++ T.unpack t
Just tt -> pure tt
instance ToJSON ClaimStatus where
toJSON tt = toJSON $ fromMaybe (error "Not all ClaimStatus have names") $ lookup tt claimTypeText
toEncoding tt = toEncoding $ fromMaybe (error "Not all ClaimStatus have names") $ lookup tt claimTypeText
data Controversial = Controversial
{ conQuestionNumber :: Text
, conAnswer :: Text
, conIssuedAt :: LocalTime
, conStatus :: ClaimStatus
, conComment :: Text
, conResolvedAt :: Text
, conAppealJuryComment :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON Controversial where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON Controversial where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
data AppealType
= AppealApprove
| AppealRemove
| AppealNarrator
deriving (Eq,Show,Read,Generic)
appealTypeText :: [(AppealType, Text)]
appealTypeText =
[ (AppealApprove, "A")
, (AppealRemove, "R")
, (AppealNarrator, "N")
]
appealTextType :: [(Text, AppealType)]
appealTextType = map swap appealTypeText
instance FromJSON AppealType where
parseJSON = withText "AppealType should be String" $ \t -> case lookup t appealTextType of
Nothing -> fail $ "Wrong AppealType " ++ T.unpack t
Just tt -> pure tt
instance ToJSON AppealType where
toJSON tt = toJSON $ fromMaybe (error "Not all AppealType have names") $ lookup tt appealTypeText
toEncoding tt = toEncoding $ fromMaybe (error "Not all AppealType have names") $ lookup tt appealTypeText
data Appeal = Appeal
{ appType :: AppealType
, appQuestionNumber :: Text
, appIssuedAt :: LocalTime
, appStatus :: ClaimStatus
, appAppeal :: Text
, appComment :: Text
, appResolvedAt :: Text
, appAnswer :: Text
} deriving (Eq,Show,Read,Generic)
instance FromJSON Appeal where
parseJSON = genericParseJSON $ jsonOpts '_' 3
instance ToJSON Appeal where
toJSON = genericToJSON $ jsonOpts '_' 3
toEncoding = genericToEncoding $ jsonOpts '_' 3
type RatingApi = "players" :> QueryParam "page" Int :> Get '[JSON] (Items Player)
:<|> "players" :> Capture "idplayer" PlayerId :> Get '[JSON] [Player]
:<|> "players" :> Capture "idplayer" PlayerId :> "teams" :> Get '[JSON] [PlayerTeam]
:<|> "players" :> Capture "idplayer" PlayerId :> "teams" :> "last" :> Get '[JSON] [PlayerTeam]
:<|> "players" :> Capture "idplayer" PlayerId :> "teams" :> Capture "idseason" Int :> Get '[JSON] [PlayerTeam]
:<|> "players" :> Capture "idplayer" PlayerId :> "tournaments" :> Get '[JSON] (SeasonMap PlayerSeason)
:<|> "players" :> Capture "idplayer" PlayerId :> "tournaments" :> "last" :> Get '[JSON] PlayerSeason
:<|> "players" :> Capture "idplayer" PlayerId :> "tournaments" :> Capture "idseason" Int :> Get '[JSON] PlayerSeason
:<|> "players" :> Capture "idplayer" PlayerId :> "rating" :> Get '[JSON] [PlayerRating]
:<|> "players" :> Capture "idplayer" PlayerId :> "rating" :> "last" :> Get '[JSON] PlayerRating
:<|> "players" :> Capture "idplayer" PlayerId :> "rating" :> Capture "idrelease" Int :> Get '[JSON] PlayerRating
:<|> "teams" :> QueryParam "page" Int :> Get '[JSON] (Items Team)
:<|> "teams" :> Capture "idteam" TeamId :> Get '[JSON] [Team]
:<|> "teams" :> Capture "idteam" TeamId :> "recaps" :> Get '[JSON] (SeasonMap TeamBaseRecap)
:<|> "teams" :> Capture "idteam" TeamId :> "recaps" :> "last" :> Get '[JSON] TeamBaseRecap
:<|> "teams" :> Capture "idteam" TeamId :> "recaps" :> Capture "idseason" Int :> Get '[JSON] TeamBaseRecap
:<|> "teams" :> Capture "idteam" TeamId :> "tournaments" :> Get '[JSON] (SeasonMap TeamTournament)
:<|> "teams" :> Capture "idteam" TeamId :> "tournaments" :> "last" :> Get '[JSON] TeamTournament
:<|> "teams" :> Capture "idteam" TeamId :> "tournaments" :> Capture "idseason" Int :> Get '[JSON] TeamTournament
:<|> "teams" :> Capture "idteam" TeamId :> "rating" :> Get '[JSON] [TeamRating]
:<|> "teams" :> Capture "idteam" TeamId :> "rating" :> "a" :> Get '[JSON] TeamRating
:<|> "teams" :> Capture "idteam" TeamId :> "rating" :> "b" :> Get '[JSON] TeamRating
:<|> "teams" :> Capture "idteam" TeamId :> "rating" :> Capture "idrelease" Int :> Get '[JSON] TeamRating
:<|> "tournaments" :> QueryParam "page" Int :> Get '[JSON] (Items TournamentShort)
:<|> "tournaments" :> Capture "idtournament" TournamentId :> Get '[JSON] [Tournament]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "list" :> Get '[JSON] [TournamentResult]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "list" :> "town" :> Capture "idtown" Int :> Get '[JSON] [TournamentResult]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "list" :> "region" :> Capture "idregion" Int :> Get '[JSON] [TournamentResult]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "list" :> "country" :> Capture "idcountry" Int :> Get '[JSON] [TournamentResult]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "recaps" :> Get '[JSON] [RecapTeam]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "recaps" :> Capture "idteam" TeamId :> Get '[JSON] [RecapPlayer]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "results" :> Capture "idteam" TeamId :> Get '[JSON] [TourResult]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "controversials" :> Get '[JSON] [Controversial]
:<|> "tournaments" :> Capture "idtournament" TournamentId :> "appeals" :> Get '[JSON] [Appeal]
:<|> "teams" :> "search" :> QueryParam "name" Text :> QueryParam "town" Text :> QueryParam "region_name" Text :> QueryParam "country_name" Text :> QueryFlag "active_this_season" :> QueryParam "page" Int :> Get '[JSON] (Items Team)
:<|> "players" :> "search" :> QueryParam "surname" Text :> QueryParam "name" Text :> QueryParam "patronymic" Text :> QueryParam "page" Int :> Get '[JSON] (Items Player)
:<|> "tournaments" :> "search" :> QueryParam "type_name" TournamentType :> QueryParam "archive" Int :> QueryParam "page" Int :> Get '[JSON] (Items TournamentShort)
data TeamName = TeamName
{ tnTeamId :: Int
, tnCurrentName :: Text
, tnCurrentTown :: Text
, tnBaseName :: Text
, tnBaseTown :: Text
} deriving (Eq,Show,Read,Generic)
instance ToJSON TeamName where
toJSON = genericToJSON $ jsonOpts '-' 2
toEncoding = genericToEncoding $ jsonOpts '-' 2
instance ToSchema TeamName where
declareNamedSchema p = genericDeclareNamedSchema (schemaOpts 2) p
& mapped.schema.title ?~ "TeamName"
& mapped.schema.description ?~ "Описание команды. В объекте содержатся поля: team-id - идентификатор команды; current-name - (разовое) название команды; current-town - (разовый) город приписки; base-name - название команды на сайте рейтинга; base-town - город приписки на сайте рейтинга"
data Request = Request
{ reqAccepted :: Maybe Bool
, reqTown :: Text
, reqRepresentativeId :: Int
, reqRepresentativeFullname :: Text
, reqNarratorId :: Int
, reqNarratorFullname :: Text
, reqTeamsCount :: Int
, reqTeams :: [TeamName]
} deriving (Eq,Show,Read,Generic)
instance ToJSON Request where
toJSON = genericToJSON $ jsonOpts '-' 3
toEncoding = genericToEncoding $ jsonOpts '-' 3
instance ToSchema Request where
declareNamedSchema p = genericDeclareNamedSchema (schemaOpts 3) p
& mapped.schema.title ?~ "Request"
& mapped.schema.description ?~ "Заявка. В объекте содержатся поля accepted - статус заявки (null - не рассмотрена, false/true - отклонена или принята); town - город; representative-id - id представителя; representative-fullname - ФИО представителя, narrator-id - id ведущего (сейчас установлена в 0, сайт рейтинга не экспортирует id); narrator-fullname - ФИО ведущего; teams-count - примерное количество команд (заявлено); teams - список введённых команд"
data SynchTown = SynchTown
{ stTournamentId :: TournamentId
, stTournament :: Text
, stStatus :: ClaimStatus
, stRepresentativeId :: PlayerId
, stRepresentative :: Text
, stTime :: LocalTime
} deriving (Eq,Show,Read,Generic)
instance ToJSON SynchTown where
toJSON = genericToJSON $ jsonOpts '-' 2
toEncoding = genericToEncoding $ jsonOpts '-' 2
type TownId = Int
data Town = Town
{ townId :: TownId
, townName :: Text
, townOtherName :: Maybe Text
, townRegion :: Maybe Text
, townCountry :: Maybe Text
} deriving (Eq,Show,Read,Generic)
instance ToJSON Town where
toJSON = genericToJSON $ jsonOpts '-' 4
toEncoding = genericToEncoding $ jsonOpts '-' 4
jsonOpts :: Char -> Int -> Options
jsonOpts c k = defaultOptions { fieldLabelModifier = camelTo2 c . drop k }
schemaOpts :: Int -> SchemaOptions
schemaOpts k = Swagger.defaultSchemaOptions
{ Swagger.fieldLabelModifier = camelTo2 '-' . drop k
, Swagger.constructorTagModifier = camelTo2 '-'
, Swagger.unwrapUnaryRecords = True
}