rating-chgk-info-0.3.6.4: src/RatingChgkInfo/Types.hs
{-|
Module : RatingChgkInfo.Types
Description : Типы для библиотеки работы с API сайта рейтинга
Copyright : (c) Mansur Ziiatdinov, 2018-2019
License : BSD-3
Maintainer : chgk@pm.me
Stability : experimental
Portability : POSIX
Типы в этом модуле практически совпадают с теми, которые возвращаются сайтом
рейтинга. Поэтому и проблемы у них (такие, как использование строк вместо целых
и т.п.) общие. Часть этих проблем задокументирована при помощи пометок __API NOTE__.
Возможно, в следующих версиях библиотеки будут какие-то способы обезопасить себя
от ошибок, либо (надеюсь) в результате развития API сайта рейтинга, либо без
этого.
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeOperators #-}
module RatingChgkInfo.Types
( -- * Работа с API
--
-- | В этом разделе описаны типы, используемые при запросах к
-- предоставляемому сайтом рейтинга REST API
--
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 (..)
-- ** Типы для идентификаторов
--
-- | Экспортируются без функций, позволяющих вытащить данные из типа,
-- поскольку предполагается, что идентификаторы получаются только из
-- запросов к серверу. Это должно помочь избежать ошибок, когда
-- идентификатор одного типа (например, id игрока) ошибочно передаётся туда,
-- где ожидается идентификатор другого типа (например, id турнира). Если вам
-- совершенно точно без этого не обойтись, используйте модуль
-- "RatingChgkInfo.Types.Unsafe".
, PlayerId
, TeamId
, TournamentId
--
-- * Работа без API
--
-- | В этом разделе - типы, которые используются при запросах к CSV-таблицам
-- на сайте рейтинга для функциональности, которая (надеюсь, пока) __не__
-- предоставляется через REST API
--
-- Функции для работы с этими типами находятся в модуле "RatingChgkInfo.NoApi"
--
-- ** Заявки на турниры
, 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)
--------------------------------------------------------------------------------
-- API Types
-- | Синоним типа для реэкспорта. Монада, в которой возможно выполнять запросы к REST API сайта рейтинга
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"
-- | Отображение сезонов на элементы
--
-- __API NOTE__: пустое отображение должно обозначаться @{}@ вместо @[]@
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 -- ^ Идентификатор игрока. __API NOTE__: должен быть @Int@
, 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 -- ^ Идентификатор игрока. __API NOTE__: должен быть @Int@
, pt_idteam :: TeamId -- ^ Идентификатор команды. __API NOTE__: должен быть @Int@
, pt_idseason :: Text -- ^ Идентификатор сезона. __API NOTE__: должен быть @Int@
, pt_is_captain :: Text -- ^ Является ли игрок капитаном (0/1). __API NOTE__: должен быть @Bool@
, 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 -- ^ Идентификатор игрока. __API NOTE__: должен быть @Int@
, ps_idseason :: Text -- ^ Идентификатор сезона. __API NOTE__: должен быть @Int@
, 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 -- ^ Идентификатор турнира. __API NOTE__: должен быть @Int@
, ptr_idteam :: TeamId -- ^ Идентификатор команды. __API NOTE__: должен быть @Int@
, ptr_in_base_team :: Text -- ^ Игра за базовую команды (0/1). __API NOTE__: должен быть @Bool@
} 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 -- ^ Идентификатор игрока. __API NOTE__: должен быть Int
, prat_idrelease :: Text -- ^ Идентификатор релиза. __API NOTE__: должен быть Int
, prat_rating :: Text -- ^ Рейтинг. __API NOTE__: должен быть Int
, prat_rating_position :: Text -- ^ Позиция в рейтинге. __API NOTE__: должен быть Int или Rational
, prat_date :: Day -- ^ Дата, когда был рассчитан рейтинг
, prat_tournaments_in_year :: Text -- ^ Количество сыгранных турниров за год. __API NOTE__: должен быть Int
, prat_tournament_count_total :: Text -- ^ Количество сыгранных турниров всего. __API NOTE__: должен быть Int
} 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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, tm_name :: Text -- ^ Название команды
, tm_town :: Text -- ^ Город приписки команды
, tm_region_name :: Text -- ^ Регион приписки
, tm_country_name :: Text -- ^ Страна
, tm_tournaments_this_season :: Text -- ^ Количество турниров, сыгранных в последнем сезоне. __API NOTE__: должен быть Int
, tm_tournaments_total :: Text -- ^ Количество турниров всего. __API NOTE__: должен быть Int
, 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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, tbr_idseason :: Text -- ^ Идентификатор сезона. __API NOTE__: должен быть Int
, tbr_players :: [Text] -- ^ Список игроков (вместе с капитаном). TODO: должен быть Set Int
, tbr_captain :: Text -- ^ Капитан команды. __API NOTE__: должен быть Maybe Int
} 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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, tt_idseason :: Text -- ^ Идентификатор сезона. __API NOTE__: должен быть Int
, tt_tournaments :: [Text] -- ^ Список идентификаторов турниров. TODO: должен быть Set Int
} 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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, rat_idrelease :: Text -- ^ Идентификатор релиза. __API NOTE__: должен быть Int
, rat_rating :: Text -- ^ Рейтинг команды. __API NOTE__: должен быть Int
, rat_rating_position :: Text -- ^ Позиция в рейтинге. __API NOTE__: должен быть Int или Rational
, rat_date :: Text -- ^ Дата, на которую рассчитан рейтинг. __API NOTE__: должен быть Day (например, @/teams/1/rating@ возвращает пустую строку для релиза 26; причём @/teams/1/rating/26@ возвращает пустой ответ)
, 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
-- | Тип турнира
--
-- __API NOTE__: типа @""@ (пустая строка) быть не должно. На данный момент (2019-01-13) таких турниров три: 2864, 2937, 2995. Типа @Неизвестный@ тоже быть не должно. Такой один: 2186
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 -- ^ Идентификатор турнира. __API NOTE__: должен быть Int
, trs_name :: Text -- ^ Название турнира
, trs_dateStart :: LocalTime -- ^ Дата начала турнира (в часовом поясе МСК)
, trs_dateEnd :: LocalTime -- ^ Дата окончания турнира (в часовом поясе МСК)
, trs_typeName :: TournamentType -- ^ Тип турнира
, trs_archive :: Text
-- ^ Архивирован ли турнир (0 - нет, 1 - да, пустая строка - турнир слишком давний). __API NOTE__: должен быть Bool
--
-- @since 0.3.6.4
, trs_dateArchivedAt :: Day
-- ^ Дата занесения в архив (может быть пустая строка). __API NOTE__: должен быть Maybe UTCTime
--
-- @since 0.3.6.4
} 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
-- | Полная информация о турнире (по отдельному запросу)
--
-- Тип 'Tournament' можно было бы объединить с 'TournamentShort', однако, в этом
-- случае бóльшая часть полей имела бы тип 'Maybe' x, что подразумевало бы
-- другой смысл, с менее строгой проверкой типов (некоторые поля могут быть
-- установлены, а некоторые нет). Поэтому было решено разделить эти два типа.
--
-- Сконвертировать 'Tournament' в 'TournamentShort' можно при помощи функции
-- 'tournamentToShort'.
--
-- В отличие от 'Tournament' в типах 'Player' и 'Team' есть единственное поле,
-- которое устанавливается в запросе более полной информации, поэтому эти типы
-- не разделены на два.
data Tournament = Tournament
{ trn_idtournament :: TournamentId -- ^ Идентификатор турнира. __API NOTE__: должен быть Int
, trn_name :: Text -- ^ Название турнира
, trn_town :: Text -- ^ Город проведения
, trn_longName :: Text -- ^ Длинное название турнира
, trn_dateStart :: LocalTime -- ^ Дата начала турнира (в часовом поясе МСК)
, trn_dateEnd :: LocalTime -- ^ Дата окончания турнира (в часовом поясе МСК)
, trn_tournamentInRating :: Text -- ^ Учитывается ли турнир в рейтинге. __API NOTE__: должен быть Bool
, trn_tourCount :: Text -- ^ Количество туров. __API NOTE__: должен быть Int
, trn_tourQuestions :: Text -- ^ Количество вопросов в туре. __API NOTE__: должен быть Int
, trn_tourQuestPerTour :: Maybe Text -- ^ Количество вопросов по турам, разделённое запятой. __API NOTE__: должен быть [Int]
, trn_questionsTotal :: Text -- ^ Количество вопросов общее. __API NOTE__: должен быть Int
, trn_typeName :: TournamentType -- ^ Тип турнира
, trn_mainPaymentValue :: Text -- ^ Размер обычного взноса
, trn_mainPaymentCurrency :: Text -- ^ Валюта обычного взноса
, trn_discountedPaymentValue :: Text -- ^ Размер льготного взноса
, trn_discountedPaymentCurrency :: Text -- ^ Валюта льготного взноса
, trn_discountedPaymentReason :: Text -- ^ Кому доступен льготный взнос
, trn_dateRequestsAllowedTo :: Text -- ^ Дата, до которой разрешена подача заявок. __API NOTE__: должен быть Day
, trn_comment :: Text -- ^ Комментарий (это __не__ текст внизу на странице турнира; например, в турнире 5003 комментарий пуст, хотя текст внизу гласит «Сроки турнира привязаны к Новому году и финалу года телеЧГК»)
, trn_siteUrl :: Text -- ^ Адрес официального сайта
, trn_archive :: Text
-- ^ Архивирован ли турнир (0 - нет, 1 - да, пустая строка - турнир слишком давний). __API NOTE__: должен быть Bool
--
-- @since 0.3.6.4
, trn_dateArchivedAt :: Day
-- ^ Дата занесения в архив (может быть пустая строка). __API NOTE__: должен быть Maybe UTCTime
--
-- @since 0.3.6.4
} 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
-- | Преобразует 'Tournament' в 'TournamentShort', убирая лишние поля
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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, tr_current_name :: Text -- ^ Название команды на турнире. Может совпадать с основным названием. Если название разовое, отличается от основного названия
, tr_base_name :: Text -- ^ Основное название команды.
, tr_position :: Text -- ^ Положение в турнирной таблице. __API NOTE__: должен быть Int or Rational
, tr_questions_total :: Text -- ^ Общее количество взятых вопросов. __API NOTE__: должен быть Int
, tr_mask :: Text -- ^ Расплюсовка команды (строка, где на каждый вопрос турнира указано: @0@ - не взят; @1@ - взят; @X@ - вопрос снят). __API NOTE__: должен быть [Bool] or [Answer]
, tr_tech_rating :: Text -- ^ Технический рейтинг команды. __API NOTE__: должен быть Int
, tr_predicted_position :: Text -- ^ Предсказанное положение в турнирной таблице. __API NOTE__: должен быть Int or Rational
, tr_bonus_a :: Text -- ^ Бонус по формуле А (аддитивной). __API NOTE__: должен быть Int
, tr_bonus_b :: Text -- ^ Бонус по формуле Б (балансной). __API NOTE__: должен быть Int
, tr_diff_bonus :: Text -- ^ Разностный балл D. __API NOTE__: должен быть Int
, tr_included_in_rating :: Text -- ^ Результаты команды будут учтены в релизе. __API NOTE__: должен быть Bool
} 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
-- | Информация об игроке в составе команды на турнире
--
-- __API NOTE__. Так как игрок не может быть одновременно в базовом составе и легионером, нужно заменить эти два поля одним, либо описать, когда игрок может не быть ни базовым, ни легионером
data RecapPlayer = RecapPlayer
{ rp_idplayer :: PlayerId -- ^ Идентификатор игрока. __API NOTE__: должен быть Int
, rp_is_captain :: Text -- ^ Является ли игрок капитаном (К). __API NOTE__: должен быть Bool
, rp_is_base :: Text -- ^ Находится ли игрок в базовом составе (Б). __API NOTE__: должен быть Bool
, rp_is_foreign :: Text -- ^ Является ли игрок легионером (Л). __API NOTE__: должен быть Bool
} 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 -- ^ Идентификатор команды. __API NOTE__: должен быть Int
, 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 -- ^ Номер тура. __API NOTE__: должен быть Int
, tor_mask :: [Text] -- ^ Расплюсовка команды (количество элементов списка совпадает с количеством вопросов в туре; каждый элемент списка либо @0@ - не взят, либо @1@ - взят, либо @X@ - вопрос снят). __API NOTE__: должен быть [Int] or [Answer]
} 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 -- ^ Новый (N)
| ClaimAccepted -- ^ Принят (A)
| ClaimRejected -- ^ Отклонён (D)
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 -- ^ Номер вопроса. __API NOTE__: должен быть @Int@
, conAnswer :: Text -- ^ Ответ команды
, conIssuedAt :: LocalTime -- ^ Время подачи. __API NOTE__: должен быть @UTCTime@
, conStatus :: ClaimStatus -- ^ Статус спорного
, conComment :: Text -- ^ Вердикт ИЖ
, conResolvedAt :: Text -- ^ Время вынесения решения. __API NOTE__: должен быть @UTCTime@
, 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 -- ^ Апелляция на зачёт ответа (A)
| AppealRemove -- ^ Апелляция на снятие вопроса (R)
| AppealNarrator -- ^ Апелляция на снятие из-за ошибки ведущего (N)
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 -- ^ Время создания. __API NOTE__: должен быть @UTCTime@
, appStatus :: ClaimStatus -- ^ Статус апелляции. Статус может быть "новая" и в том случае, если апелляция не рассмотрена, так как была зачтена другая апелляция
, appAppeal :: Text -- ^ Текст апелляции
, appComment :: Text -- ^ Вердикт АЖ
, appResolvedAt :: Text -- ^ Время публикации вердикта. __API NOTE__: должен быть @UTCTime@
, 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
-- | Тип, описывающий API сайта рейтинга. Функции, которые позволяют делать запросы к API, находятся в модуле "RatingChgkInfo.Api"
--
-- Некоторые замечания по общему дизайну API:
--
-- * __API NOTE__: в запросах @\/players\/:id@, @\/tournaments\/:id@ и некоторых других должен возвращаться единственный результат вместо списка из одного результата
--
-- * __API NOTE__: в запросе @\/players\/:id\/teams@ и других запросах, возвращающие элементы по сезонам, следует возвращать список вместо отображения номера сезона на элемент (идентификатор сезона дублируется в самом элементе)
--
-- * __API NOTE__: запросы, возвращающие элементы по сезонам, и запрос @\/tournaments\/:tourn\/results\/:team@ устроены по-разному
--
-- * __API NOTE__: запрос @\/teams\/:id\/rating\/:formula@, по-видимому, несколько сломан: для команды 1 он возвращает пустую строку (по состоянию на 2019-01-11)
--
-- * __API NOTE__: запрос @\/players\/:id\/rating\/last@, по-видимому, нсколько сломан: для игрока 54345 он возвращает пустую строку (по состоянию на 2019-01-11)
--
-- * __API NOTE__: запросы @\/tournament\/:id\/town\/:town@ должны использовать QueryParam вместо параметров путей
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] -- TODO: Set?
:<|> "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] -- TODO: Set?
:<|> "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] -- TODO: Set?
:<|> "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] -- TODO: Set?
:<|> "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)
--------------------------------------------------------------------------------
-- Non-API Types
-- | Название команды на турнире
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 -- ^ Идентификатор ведущего (сайт рейтинга не экспортирует его в CSV, поэтому всегда установлен в 0)
, 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
}