{-|
Module : RatingChgkInfo
Description : Функции для работы с API сайта рейтинга
Copyright : (c) Mansur Ziiatdinov, 2018-2019
License : BSD-3
Maintainer : chgk@pm.me
Stability : experimental
Portability : POSIX
Клиент для REST API сайта рейтинга (rating.chgk.info) и функциональности, которой нет в REST API, но которая доступна через экспорт CSV.
Также содержит REST-сервер для дополнительной функциональности, доступной через CSV
Документация по типам параметров и возвращаемых значений находится в "RatingChgkInfo.Types"
Документация по функциям для работы с REST API находится в "RatingChgkInfo.Api"
Документация по функциям для работы с CSV находится в "RatingChgkInfo.NoApi"
В следующем большом релизе планируется заменить в части типов для REST API списки значений на множества (Set), например, для составов команд и т.п. Это должно повысить безопасность библиотеки, и не должно ухудшить возможности работы.
Пример использования:
>
> -- Немного наших библиотек
> import RatingChgkInfo.Types
> import RatingChgkInfo.Api
>
> -- И немного стандартных библиотек
> import Control.Monad (forM, void)
> import Control.Monad.IO.Class (liftIO)
> import Data.List (nub)
> import Data.Time (LocalTime(..),fromGregorian,midnight)
>
> -- Точка входа в приложение
> main :: IO ()
>
> -- Функция runRatingApi запускает работу клиента, это позволяет разделять эффекты
> main = void $ runRatingApi $ do
>
> -- Получим список всех очных турниров за 2018 год
>
> let s2018 = LocalTime (fromGregorian 2018 1 1) midnight
> e2018 = LocalTime (fromGregorian 2019 1 1) midnight
>
> -- Функция tournaments получает одну страницу турниров, а функция getAllItems
> -- оборачивает подобные функции, чтобы пройтись по всем страницам.
> -- Далее из этого списка выбираются очные турниры 2018 года
> tourns <- filter (\t -> trs_typeName t == Casual &&
> trs_dateStart t >= s2018 &&
> trs_dateEnd t <= e2018) <$>
> getAllItems tournaments
>
> -- Проходимся по полученному списку
> ts <- forM tourns $ \t -> do
>
> -- API сайта рейтинга выдаёт строки в качестве идентификаторов, а нам нужны числа
> let ident = apiIdToInt (trs_idtournament t)
>
> -- Получаем результаты турнира
> res <- tournamentResults ident
>
> -- Возвращаем названия команд-участниц
> pure (map tr_current_name res)
>
> -- Выводим, сколько уникальных названий было по всем турнирам
> liftIO (print (length (nub ts)))
-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
{-
Imports selected entities from rating.chgk.info into following directory structure:
+ players/
| + NNxxx/
| + NNABC.json
| + NNABC.M.json
| + NNABC.diff.M.json
+ tournaments/
| + NNxxx/
| + NNABC/
| + props.json -> props.M.json
| + props.M.json
| + props.diff.M.json
| + recap.json -> recap.M.json
| + recap.M.json
| + recap.diff.M.json
| + result.json -> result.M.json
| + result.M.json
| + result.diff.M.json
| + request.json -> request.M.json
| + request.M.json
| + request.diff.M.json
| + controversial.json -> controversial.M.json
| + controversial.M.json
| + controversial.diff.M.json
| + appeal.json -> appeal.M.json
| + appeal.M.json
| + appeal.diff.M.json
+ lastsync
Here NNABC is numeric identifier, M is a timestamp (seconds from epoch) of synchronization start.
File entity.diff.M.json describes changes between M version and next version.
File lastsync contains a timestamp of last synchronization attempt.
-}
module RatingChgkInfo
( -- * Библиотека API
module Rating
, generateJavascript
-- * Сервер дополнительного API
, extraRatingApiDesc
, extraRatingApiApp
, extraRatingApiMain
) where
-- import RatingChgkInfo.Api (getAllItems, runRatingApi)
import RatingChgkInfo.Api as Rating
import RatingChgkInfo.Extra
import RatingChgkInfo.NoApi as Rating
import RatingChgkInfo.Types as Rating
import qualified Control.Exception as E
import Data.Aeson (encode)
-- import Options.Generic
-- import Data.Aeson.Diff
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Text (Text)
-- import qualified Data.Text as T
-- import qualified Data.Text.IO as T
-- import Data.Time (getCurrentTime, diffUTCTime, fromGregorian, UTCTime(..))
import Network.Socket
import Network.Wai.Handler.Warp
-- import Options.Generic (unwrapRecord, Unwrapped)
import Servant.JS
-- import System.Directory
import System.Environment
-- import System.FilePath
-- import Text.Printf
-- import Text.Read
-- -- | Тип для работы утилиты командной строки
-- data CliOptions w
-- = Players
-- { _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Tournaments
-- { _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Recaps
-- { _tournament :: w ::: Int <?> "Tournament identifier"
-- , _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Results
-- { _tournament :: w ::: Int <?> "Tournament identifier"
-- , _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Requests
-- { _tournament :: w ::: Int <?> "Tournament identifier"
-- , _withTeams :: w ::: Bool <?> "Include teams"
-- , _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Controversials
-- { _tournament :: w ::: Int <?> "Tournament identifier"
-- , _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | Appeals
-- { _tournament :: w ::: Int <?> "Tournament identifier"
-- , _diff :: w ::: Bool <?> "Generate diff if entity exists"
-- }
-- | GenerateJs
-- deriving (Generic)
--
-- instance ParseRecord (CliOptions Wrapped) where
-- parseRecord = parseRecordWithModifiers $ lispCaseModifiers
-- deriving instance Show (CliOptions Unwrapped)
--
-- log, logLn :: LByteString -> IO ()
-- log = LB.hPutStr stderr
-- logLn = LB.hPutStrLn stderr
--
-- createDirs :: IO ()
-- createDirs = do
-- createDirectoryIfMissing True "players"
-- createDirectoryIfMissing True "tournaments"
--
-- printDot :: Int -> Int -> IO ()
-- printDot cnt ident = do
-- when (ident `mod` cnt == 0) $ log "."
-- when (ident `mod` (10*cnt) == 0) $ log " "
-- when (ident `mod` (80*cnt) == 0) $ logLn ""
--
-- getPlayers :: Bool -> Int -> IO ()
-- getPlayers _diff ts = do
-- logLn "Rating Api: GET /players"
-- eps <- runRatingApi $ getAllItems $ \mpage -> do
-- liftIO $ printDot 1 $ fromMaybe 1 mpage
-- Api.players mpage
-- logLn ""
-- case eps of
-- Left err -> print err
-- Right ps -> withCurrentDirectory "players" $ do
-- logLn "Write players:"
-- forM_ ps $ \p -> do
-- let ident = apiIdToInt $ idplayer p
-- dir = (printf "%03d" $ ident `div` 1000) ++ "xxx"
-- fname = show ident ++ "." ++ show ts ++ ".json"
-- -- lfile = show ident ++ "." ++ ".json"
-- printDot 1000 ident
-- createDirectoryIfMissing True dir
-- LB.writeFile (dir </> fname) $ encode p
-- logLn ""
--
-- getTournaments :: Bool -> Int -> IO ()
-- getTournaments _diff now = do
-- logLn "Rating Api: GET /tournaments"
-- eps <- runRatingApi $ getAllItems $ \mpage -> do
-- liftIO $ printDot 1 $ fromMaybe 1 mpage
-- Api.tournaments mpage
-- logLn ""
-- case eps of
-- Left err -> print err
-- Right ts -> withCurrentDirectory "tournaments" $ do
-- logLn "Write tournaments:"
-- forM_ (zip [1..] ts) $ \(i,tourn) -> do
-- let t = apiIdToInt $ trs_idtournament tourn
-- dname = printf "%02d" (t `div` 1000) ++ "xxx"
-- fname = "props." ++ show now ++ ".json"
-- shortName = "short." ++ show now ++ ".json"
-- dir = dname </> show t
-- printDot 10 i
-- createDirectoryIfMissing True dir
-- et <- runRatingApi $ Api.tournament t
-- LB.writeFile (dir </> shortName) $ encode tourn
-- case et of
-- Left err -> print err
-- Right [fullTourn] -> LB.writeFile (dir </> fname) $ encode fullTourn
-- Right _ -> error "Tournament API has changed, it doesn't return [tourn]"
--
-- getRecaps :: Int -> IO ()
-- getRecaps _t = pure ()
--
-- getResults :: Int -> IO ()
-- getResults _t = pure ()
--
-- getRequests :: Int -> Int -> IO ()
-- getRequests t now = do
-- let dname = printf "%02d" (t `div` 1000) ++ "xxx"
-- fname = "request." ++ show now ++ ".json"
-- dir = "tournaments" </> dname </> show t
-- createDirectoryIfMissing True dir
-- withCurrentDirectory dir $ do
-- logLn $ LB.pack $ "Rating Non-API: team_synch_data " ++ show t
-- ers <- NoApi.requests t
-- case ers of
-- Left err -> print err
-- Right rs -> LB.writeFile fname $ encode rs
-- logLn ""
--
-- getControversials :: Int -> IO ()
-- getControversials _t = pure ()
--
-- getAppeals :: Int -> IO ()
-- getAppeals _t = pure ()
--
-- importer :: CliOptions Unwrapped -> IO ()
-- importer opts = do
-- print (opts :: CliOptions Unwrapped)
-- -- get current timestamp
-- old <- ifM (doesFileExist "lastsync") (read <$> readFile "lastsync") (pure 0)
-- let toEpoch :: UTCTime -> Double
-- toEpoch = realToFrac . flip diffUTCTime (UTCTime (fromGregorian 1970 1 1) 0)
-- now <- (truncate . toEpoch) <$> getCurrentTime
-- print (old :: Int,now :: Int)
-- -- create directories
-- createDirs
-- -- actual parsing
-- case opts of
-- Players diff -> getPlayers diff now
-- Tournaments diff -> getTournaments diff now
-- Recaps t _diff -> getRecaps t
-- Results t _diff -> getResults t
-- Requests t _withTeams _diff -> getRequests t now
-- Controversials t _diff -> getControversials t
-- Appeals t _diff -> getAppeals t
-- writeFile "lastsync" $ show now
--
-- | Текст js-скрипта
generateJavascript :: Text
generateJavascript = jsForAPI (Proxy :: Proxy RatingApi) vanillaJS
-- ratingChgkInfoApp :: IO ()
-- ratingChgkInfoApp = do
-- -- get cli options
-- opts <- unwrapRecord help
-- case opts of
-- GenerateJs -> T.putStrLn $ jsForAPI (Proxy :: Proxy RatingApi) vanillaJS
-- _ -> importer opts
-- where
-- help = T.intercalate "\n"
-- [ "Import rating.chgk.info entities"
-- , ""
-- , "Not implemented commands: controversials, appeals"
-- , "Implemented partially: "
-- , " - tournaments parse only fields from API"
-- , " - requests do not parse narrator and can contain zero ids (r.c.i. limitation)"
-- , "Differences from API:"
-- , " - ids are converted to Int"
-- ]
-- | Запуск сервера дополнительного API
extraRatingApiMain :: IO ()
extraRatingApiMain = do
args <- getArgs
case args of
["doc"] -> LB.putStrLn $ encode extraRatingApiDesc
["srv", addr] -> case readMaybe addr of
Just port -> run port extraRatingApiApp
Nothing -> E.bracket
(socket AF_UNIX Stream 0 >>= \s -> bind s (SockAddrUnix addr) >> pure s)
close
(\sock -> runSettingsSocket defaultSettings sock extraRatingApiApp)
_ -> usage
where usage = putStrLn "Usage: extra-rating-api [doc | srv <port> | srv <sock>]"