{-|
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
  }