{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
module RatingChgkInfo.NoApi
( requests
) where
import Prelude hiding (ByteString, get)
import RatingChgkInfo.Types
import RatingChgkInfo.Types.Unsafe (TournamentId (..))
import Codec.Text.IConv
import Control.Lens
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Csv
import Data.List
import qualified Data.Map as M
import qualified Data.Map.Merge.Lazy as M
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Read
import Network.Wreq
data CsvTeam = CsvTeam
{ ctTown :: Text
, ctRepId :: Maybe Int
, ctRepSurname :: Text
, ctRepName :: Text
, ctRepPatronym :: Text
, ctTeamId :: Int
, ctTeam :: Text
, ctTeamTown :: Text
, ctFlags :: Text
, ctTeamBaseName :: Text
, ctTeamBaseTown :: Text
, ctBaseIsCurrent :: Int
} deriving (Eq,Show,Read,Generic)
instance FromRecord CsvTeam
data CsvRequest = CsvRequest
{ crTown :: Text
, crRepresentative :: Text
, crNarrator :: Text
, crStatus :: Text
, crTeams :: Text
} deriving (Eq,Show,Read,Generic)
instance FromRecord CsvRequest
requests :: TournamentId
-> IO (Either B.ByteString [Request])
requests (TournamentId t) = do
let url1 = "http://rating.chgk.info/synch.php?download_data=requests_download&tournament_id=" ++ T.unpack t
url2 = "http://rating.chgk.info/synch.php?download_data=teams_synch_data&tournament_id=" ++ T.unpack t
r1 <- get url1
case r1 ^. responseStatus . statusCode of
200 -> do
let ereqs = parseRequests (show t) $ r1 ^. responseBody
r2 <- get url2
pure $ case r2 ^. responseStatus . statusCode of
200 -> let
eteams = parseTeams $ r2 ^. responseBody
in case ereqs of
Left err -> case take 114 err of
"parse error (Failed reading: conversion error: cannot unpack array of length 1 into a Only. Input record: [\"<html>" ->
Left "No such tournament, returned html"
"parse error (not enough input) at \"\"" ->
Left "Not a synch, or no requests yet"
_ -> Left $ B.pack err
Right reqs -> case eteams of
Left _ -> Right reqs
Right teams -> Right $ M.elems $ combineTeamsRequests teams reqs
_ -> Left $ r2 ^. responseStatus . statusMessage
_ -> pure $ Left $ r1 ^. responseStatus . statusMessage
where combineTeamsRequests ts rs = M.merge M.preserveMissing M.preserveMissing (M.zipWithMatched combine) (mkMap ts) (mkMap rs)
mkMap = M.fromList . map fromReq
fromReq req@(Request{ reqTown = town, reqRepresentativeFullname = rep }) = ((town,rep), req)
combine
(town, repFullname)
Request{ reqRepresentativeId = repId
, reqTeams = teams
}
Request{ reqAccepted = acc
, reqNarratorFullname = narFullname
, reqTeamsCount = n
}
= Request { reqAccepted = acc
, reqTown = town
, reqRepresentativeId = repId
, reqRepresentativeFullname = repFullname
, reqNarratorId = 0
, reqNarratorFullname = narFullname
, reqTeamsCount = n
, reqTeams = teams
}
parseRequests :: String -> ByteString -> Either String [Request]
parseRequests tid bs = decodeWith csvOpts HasHeader
(convert "CP1251" "UTF-8" bs)
>>= mapM csvRequestToRequest . toList
where csvRequestToRequest CsvRequest{ crTown = town
, crRepresentative = repName
, crNarrator = narName
, crStatus = status
, crTeams = cnt }
= let n = either (const (-1)) fst $ decimal $ snd $ T.breakOnEnd " / " cnt
in Right $ Request
{ reqAccepted = case status of
"Принята" -> Just True
"Отказано" -> Just False
"Новая" -> Nothing
_ -> error $ T.concat ["Unknown request status in ", T.pack tid, ": ", status]
, reqTown = town
, reqRepresentativeId = 0
, reqRepresentativeFullname = repName
, reqNarratorId = 0
, reqNarratorFullname = narName
, reqTeamsCount = n
, reqTeams = []
}
parseTeams :: ByteString -> Either String [Request]
parseTeams = fmap (map csvTeamGroupToRequest .
groupBy ((==)`on`ctRepId) .
toList) .
decodeWith csvOpts HasHeader .
convert "CP1251" "UTF-8"
where csvTeamGroupToRequest cs@(cr:_) = Request
{ reqAccepted = Nothing
, reqTown = ctTown cr
, reqRepresentativeId = fromMaybe 0 $ ctRepId cr
, reqRepresentativeFullname = T.concat
[ ctRepSurname cr
, " "
, ctRepName cr
, " "
, ctRepPatronym cr
]
, reqNarratorId = 0
, reqNarratorFullname = ""
, reqTeamsCount = 0
, reqTeams = map ctToTeam cs
}
csvTeamGroupToRequest [] = error "Impossible happened: [] in csvTeamGroupToRequest"
ctToTeam CsvTeam
{ ctTeamId = ident
, ctTeam = current
, ctTeamTown = curTown
, ctTeamBaseName = base
, ctTeamBaseTown = baseTown
} = TeamName ident current curTown base baseTown
csvOpts :: DecodeOptions
csvOpts = defaultDecodeOptions
{ decDelimiter = fromIntegral $ ord ';'
}