{-| 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>]"