11380
+ − 1
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
11358
+ − 2
module Main where
+ − 3
11380
+ − 4
import Data.Maybe
+ − 5
import Data.TConfig
+ − 6
import qualified Data.ByteString.Char8 as B
+ − 7
import Database.MySQL.Simple
+ − 8
import Database.MySQL.Simple.QueryResults
+ − 9
import Database.MySQL.Simple.Result
+ − 10
import Control.Monad
+ − 11
import Control.Exception
+ − 12
import System.IO
+ − 13
import qualified Data.Map as Map
11381
+ − 14
import Data.Time.Clock
11380
+ − 15
------
+ − 16
import OfficialServer.Glicko2
+ − 17
11358
+ − 18
11380
+ − 19
queryEpochDates = "SELECT epoch, todatetime, todatetime + INTERVAL 1 week FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)"
+ − 20
queryPreviousRatings = "SELECT v.userid, v.rating, v.rd, v.volatility FROM rating_values as v WHERE (v.epoch = (SELECT MAX(epoch) FROM rating_epochs))"
+ − 21
queryGameResults =
+ − 22
"SELECT \
+ − 23
\ p.userid \
+ − 24
\ , p.place \
+ − 25
\ , COALESCE(vp.rating, 1500) \
+ − 26
\ , COALESCE(vp.rd, 350) \
+ − 27
\ , COALESCE(vp.volatility, 0.06) \
+ − 28
\ , COALESCE(vo.rating, 1500) \
+ − 29
\ , COALESCE(vo.rd, 350) \
+ − 30
\ , COALESCE(vo.volatility, 0.06) \
+ − 31
\ FROM \
+ − 32
\ (SELECT epoch, todatetime FROM rating_epochs WHERE epoch = (SELECT MAX(epoch) FROM rating_epochs)) as e \
+ − 33
\ JOIN rating_games as g ON (g.time BETWEEN e.todatetime AND e.todatetime + INTERVAL 1 WEEK - INTERVAL 1 SECOND) \
+ − 34
\ JOIN rating_players as p ON (p.gameid = g.id) \
+ − 35
\ JOIN rating_players as o ON (p.gameid = o.gameid AND p.userid <> o.userid AND (p.place = 0 OR (p.place <> o.place))) \
+ − 36
\ LEFT OUTER JOIN rating_values as vp ON (vp.epoch = e.epoch AND vp.userid = p.userid) \
+ − 37
\ LEFT OUTER JOIN rating_values as vo ON (vo.epoch = e.epoch AND vo.userid = o.userid) \
+ − 38
\ GROUP BY p.userid, p.gameid, p.place \
+ − 39
\ ORDER BY p.userid"
11390
+ − 40
insertNewRatings = "INSERT INTO rating_values (userid, epoch, rating, rd, volatility, games) VALUES (?, ?, ?, ?, ?, ?)"
11381
+ − 41
insertNewEpoch = "INSERT INTO rating_epochs (epoch, todatetime) VALUES (?, ?)"
11380
+ − 42
11381
+ − 43
mergeRatingData :: Map.Map Int (RatingData, [GameData]) -> [(Int, (RatingData, [GameData]))] -> Map.Map Int (RatingData, [GameData])
11390
+ − 44
mergeRatingData m s = foldr (uncurry (Map.insertWith mf)) m s
11381
+ − 45
where
+ − 46
mf (rd, gds) (_, gds2) = (rd, gds ++ gds2)
+ − 47
11380
+ − 48
calculateRatings dbConn = do
11381
+ − 49
[(epochNum :: Int, fromDate :: UTCTime, toDate :: UTCTime)] <- query_ dbConn queryEpochDates
11380
+ − 50
initRatingData <- (Map.fromList . map fromDBrating) `fmap` query_ dbConn queryPreviousRatings
11381
+ − 51
gameData <- map fromGameResult `fmap` query_ dbConn queryGameResults
+ − 52
let mData = map getNewRating . Map.toList $ mergeRatingData initRatingData gameData
+ − 53
executeMany dbConn insertNewRatings $ map (toInsert epochNum) mData
+ − 54
execute dbConn insertNewEpoch (epochNum + 1, toDate)
11380
+ − 55
return ()
+ − 56
where
11390
+ − 57
toInsert e (i, (g, RatingData r rd v)) = (i, e + 1, r, rd, v, g)
11381
+ − 58
getNewRating (a, d) = (a, uncurry calcNewRating d)
+ − 59
convPlace :: Int -> Double
+ − 60
convPlace 0 = 0.5
+ − 61
convPlace 1 = 1.0
+ − 62
convPlace 2 = 0.0
+ − 63
convPlace _ = error "Incorrect place value"
11380
+ − 64
fromDBrating (a, b, c, d) = (a, (RatingData b c d, []))
11381
+ − 65
fromGameResult (pid, place, prating, pRD, pvol, orating, oRD, ovol) =
+ − 66
(pid,
+ − 67
(RatingData prating pRD pvol
+ − 68
, [GameData (RatingData orating oRD ovol) $ convPlace place]))
11380
+ − 69
+ − 70
+ − 71
data DBConnectInfo = DBConnectInfo {
+ − 72
dbHost
+ − 73
, dbName
+ − 74
, dbLogin
+ − 75
, dbPassword :: B.ByteString
11358
+ − 76
}
+ − 77
11380
+ − 78
cfgFileName :: String
+ − 79
cfgFileName = "hedgewars-server.ini"
11358
+ − 80
+ − 81
11380
+ − 82
readServerConfig :: ConnectInfo -> IO ConnectInfo
+ − 83
readServerConfig ci = do
+ − 84
cfg <- readConfig cfgFileName
+ − 85
return $ ci{
+ − 86
connectHost = value "dbHost" cfg
+ − 87
, connectDatabase = value "dbName" cfg
+ − 88
, connectUser = value "dbLogin" cfg
+ − 89
, connectPassword = value "dbPassword" cfg
+ − 90
}
11358
+ − 91
where
11380
+ − 92
value n c = fromJust2 n $ getValue n c
+ − 93
fromJust2 n Nothing = error $ "Missing config entry " ++ n
+ − 94
fromJust2 _ (Just a) = a
11358
+ − 95
11380
+ − 96
dbConnectionLoop mySQLConnectionInfo =
+ − 97
Control.Exception.handle (\(e :: SomeException) -> hPutStrLn stderr $ show e) $
+ − 98
bracket
+ − 99
(connect mySQLConnectionInfo)
+ − 100
close
+ − 101
calculateRatings
11358
+ − 102
11380
+ − 103
main = readServerConfig defaultConnectInfo >>= dbConnectionLoop