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